Excel - uložení jednotlivých listů sešitu jako samostatné soubory

V posledním odstavci máš návod, jak to tam vložit.

It is not a built-in feature.

However, if you run this code, it should do the job.

Sub SaveSheets()
Dim strPath As String
Dim ws As Worksheet

Application.ScreenUpdating = False

strPath = ActiveWorkbook.Path & "\"
For Each ws In ThisWorkbook.Sheets
ws.Copy
'Use this line if you want to break any links:
BreakLinks Workbooks(Workbooks.Count)
Workbooks(Workbooks.Count).Close True, strPath & ws.Name & ".xlsx"
Next

Application.ScreenUpdating = True
End Sub

Sub BreakLinks(wb As Workbook)
Dim lnk As Variant
For Each lnk In wb.LinkSources(xlExcelLinks)
wb.BreakLink lnk, xlLinkTypeExcelLinks
Next
End Sub

To run the code, do the following:

Open the VBA editor (Alt+F11)
In the tree in the top left corner, right click on your workbook and insert a new module
Copy the above code into this module
Close the VBA editor
In Excel press Alt+F8 to run macros and select SaveSheets

Pochop, já tomu nerozumím (english jo, kódu ne). Nevím, jak ten skript vůbec narvat do excelu coby nabídku skriptů v jakémkoliv (každém) sešitu, který otevřu.

Ja sice tomu nerozumiem tiez, ale popis je dostacujuci na to, aby sto aspon skusil.
Na konci mas popis ako mas otvorit makro, co donho vlozit ako ulozit a ako sa nasledne spusti priamo z Excelu.

Open the VBA editor (Alt+F11)
In the tree in the top left corner, right click on your workbook and insert a new module
Copy the above code into this module
Close the VBA editor
In Excel press Alt+F8 to run macros and select SaveSheets

Žádný strom tam nemám. Jen prázdné šedé okno.

Po Ctrl + R nevyskočí?

Vyskočí. Dík. Jak to ale uložím? Ono to chce při sejvu nacpat do implicitního sheetu, já to chci ale "globálně" (aby byl script dostupný ve všech otevřených sešitech).

edit: A stejně nefunguje...

Ano, má to nejakú chybu ale nechcel som nad tým rozmýšľať, tak som vyrobil krátke makro bez nejakých ďalších ošetrovačiek, aby som Ti to zjednodušil...
Prikopíruj si sem za prvý hárok všetky hárky Tvojho zošita a na prvom hárku "xxx" stlač tlačidlo.
Súbory sa Ti vytvoria do toho istého adresára, kde budeš mať uložený tento súbor.
(Pôvodný Tvoj súbor si ponechaj pre istotu ako zálohu)

Ak sa Ti zdá hlúpe prikopírovávať do môjho súboru svoje hárky (aj keď sa to dá veľmi jednoducho a naraz), tak proste si pozri makro, ktoré mám v mojom súbore (nájdeš ho v "module1" editora VBA (ALT+F11)) a celý modul skopíruj i do svojho súboru.
Potom vo svojom súbore dáš zobraziť makrá a spustíš SheetsToFiles. V tomto prípade však nevyrobí súbor z prvého hárku, lebo to je ten môj spúšťací.
Ak to chceš napraviť, tak si alebo môj prvý hárok skopíruješ do svojho súboru ako prvý, alebo upravíš cyklus v makre na for i=1 to .... namiesto terajšieho for i=2 to...
Prípadne mi ten súbor pošleš cez poštu, ja Ti to upravím a pošlem späť, Ty to u seba už len spustíš

Díky, ale těch sešitů je cca patnáct set. Potřebuju jednoduchý "konvertor" listů na soubory, který by byl dostupný přímo z menu Excelu. Ale za tvou invenci ti ještě jednou děkuji.

Ale to je detto, či Ti tu radia, len Ty si to vkladáš cez editor do modulu zošita. Ja ti to dávam do všeobecného modulu.
Takže Ty by si potreboval doplnok, ktorý bude všeobecne prítomný...
Takto som to zatiaľ neriešil ale ani to nie je problém, len momentálne nestíham.
Takže zatiaľ Ti viem poradiť len toľko, že môj modul si skopíruj do svojho zošita tiež do všeobecného modulu a uprav si for i=2 na for i=1
Potom už len spusti makro a máš prvý súbor rozsekaný...

Ak chceš skúšať, ulož si to ako doplnok a potom doplnok aktivuj a malo by sa to stať globálnym...
Prakticky som to osobne ešte neskúšal ale takto nejak to funguje, prípadne Ti tu poradia ostatní.
Lenže pozor, moje makro nie je blbuvzdorné, zbachol som ho narýchlo pre jednorazovku...

ulož si to ako doplnok a potom doplnok aktivuj

Jak na to?

alebo ako osobný zošit makier?
Počkaj, skúsim to nájsť...

Takže je to veľmi jednoduché:
Jedná sa o osobný zošit makier, ktorý je globálny a do neho si nasáčkuješ všetky makrá, ktoré chceš mať stále poruke.

Nasledujúci kód:

Sub SheetsToFiles()
    On Error GoTo Chyba
    Application.ScreenUpdating = False
    Zdroj = ActiveWorkbook.Name
    Cesta = ActiveWorkbook.Path & "\"
    For i = 1 To ActiveWorkbook.Sheets.Count
        Meno = Sheets(i).Name & ".xlsx"
        Sheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=Cesta & Meno
        ActiveWindow.Close
        Workbooks(Zdroj).Activate
    Next i
    Application.ScreenUpdating = True
    MsgBox "Vytvorenie samostatných súborov z hárkov súboru " & Zdroj & " bolo úspešne ukončené." & Chr(13) & "Nové súbory sú uložené v zložke " & Cesta, vbInformation, "Oznam"
    Exit Sub
Chyba:
    MsgBox "Vyskytla sa neočakávaná chyba", vbCritical, "Chyba"
End Sub

si nakopíruj do Module1 osobného zošita makier PERSONAL.XLSB (viď priložený obrázok). Ten sa otvára pri každom spustení Excelu. Zošit s osobnými makrami ostáva neviditeľný ale jeho makrá sú k dispozícii.

Potom si otvoríš zošit (nesmie byť nový, musí ísť o už existujúci súbor) a "nad ním" si spustíš makro (karta Vývojár- zobraziť makrá) SheetsToFiles.

Tadááááá

Pôvodný súbor ostane otvorený a nedotknutý, keďže nové súbory sa vytvoria ako kópie existujúcich hárkov, nie ich presunutím...

Tohle fakt neznám. Otevřu toto:

mne sa zobrazil aj osobný zošit makier... Ale možno až po tom, čo som experimentačne vytvoril makro a smeroval ho do osobného zošita makier.
Tak to zopakujeme.
Vieš zaznamenať makro?
Zatiaľ nerob nič, len mi odpovedaj. Budem Ťa nevigovať

Ne. S makrama jsem nikdy nedělal. Odpusť mi neznalost, ale nikdy jsem to nepotřeboval .

V poriadku, nikto Ti nič nevyčíta... Preto sa pýtam...
Kartu Vývojár máš povolenú?

A teď mi ještě dokleplo - já mám na prackrámu O2003 (na němž tvé rady zkouším), ale v práci, kde budu makro potřebovat, je O2010.

to na veci nič nemení, akurát nástroje sú po novom na ribbonoch a na O2003 je to klasický panel nástrojov.
Takže teraz robíš na 2003?
Budem si musieť spomenúť, kde sú v 2003 makrá, myslím že Nástroje-Možnosti...
Pošli screen panela

No dobře, ale jak otevřu ten "personal.xlsb"?

zaznamenáš si najprimitívnejšie makro len kvôli tomu, aby si si sprístupnil v tom okne, screen ktorého si poslal, súčasť projektu personal.xlsb

Preto sa pýtam, či vieš zaznamenať makro. Pri zahájení zaznamenávania sa totiž môžeš rozhodnúť, či má byť zaznamenané do aktuálneho zošita alebo do osobného zošita makier...

a niečo naznačil aj pme a mne trklo, že na 2003 sa bude musieť súbor volať xls, na 2010 xlsx adetto personal na 2003 bude mať inú príponu ako na 2010 ale to vieme poriešiť.

Tohle bude asi jedno. Mám svůj stoletý "oufis" opatchovaný, takže s extezí IMHO problémy nebudou.

no nič, skúsime to ako naznačil kmochna.
Posielam Ti niečo. Daj si vyhľadať zložku XLSTART a do nej to ulož(pokiaľ tam zatiaľ nemáš personal.xls !)
A po novom otvorení excelu by to malo ísť.
Skús, či ti to ide a ak ano, pošlem Ti verziu, ktorú takým istým spôsobom vložíš do xlstart v práci

a toto vložíš takým istým spôsobom do XLSTART na PC kde máš E 2010 (len ak tam zatiaľ nemáš iné personal.xlsb !!! Pokiaľ tam už Personal.xlsb existuje, budeš musieť nové makro pridať k jestvujúcim...)

No nič, ja končím, poradia Ti ďalší kamoši...

Nechcem sa do toho veľmi montovať, ale v rámci čo najväčšieho zjednodušenia pre mifa, prosímťa skús mu vyexportovať to makro ako *.bas, to bude asi jednoduchšie ako navigovať čo kde nakopírovať.

Inak základy vytvorenia makra a zobrazenie tabu "vývojár" /developer:
Create your first macro in excel: MYNVaRnZRgY

ok ale ako to dostane do personal.xlsb?
Tak či tak by som ho musel navádzať aby to dostal tam, kam to patrí...

file-import sa mi zdalo jednoduchšie ako kopírovať zdroják.

Inak problém s chýbajúcim personal.xls som kedysi riešil, nakoniec som vytvoril prázdny súbor personal.xls a nakopíroval do "xlstart" foldra lebo inak som excel nevedel presvedčiť aby si ho vytvoril :)

stačí skusmo zaznamenať nejakú blbinu (avšak zaznamenať do personal), vznikne personal a tam potom to skúšobné makro nahradíš svojim a je to.
Zdá sa mi to jednoduchšie ako hľadať kde je xlstart a pod...

ok ale kam ho importuješ, keď personal je neviditeľný? :)

Prepáč, ale ak to chceš doriešiť, tak sa snaž reagovať, lebo o chvíľku vypínam...

Ja neviem, ale tento jednoduchý postup by si mohol zvládnuť:

1. Otvor si súbor v Exceli
2. Stlač Alt + F11 (otvorí sa Microsoft Visual Basic for Applications)
3. Choď do Menu - Insert -> Module (otvorí sa okno, kde píšeš VBA)
4. Vraž tam tento kód:

Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
xWs.Copy
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case xWb.FileFormat
Case 51:
FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If Application.ActiveWorkbook.HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56:
FileExtStr = ".xls": FileFormatNum = 56
Case Else:
FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

5. Stlač F5 - vytvorí sa adresár s názvom pôvodného súboru, kde budú vyexportované všetky listy pod svojimi názvami

Good luck...

trocha si nepochopil, že mu ide o globálny prístup... súborov má x...

Ale máš pravdu s verziami Excelu - rozdiel v príponách urobí svoje...

nechci se do toho moc míchat, ale nemůže být ztroskotání v prostém stažení souboru namísto vkopírování do texťáku? zóny jsou sviňa.

myslíš rovno poslať personal.xlsb? Tož tiež by šlo. Ale pokiaľ má v práci už nejaké personal vytvorené, tak nahradením by o tie pôvodné makrá prišiel a sme tam kde sme boli - musí si to vedieť pridať k pôvodným...

právě, že ne. zkopírování odtud a vložení do textu u sebe. není zřejmé jak je nastaven systém u mifa. pokud to funguje u tebe, musí to fungovat u něj.

Nechápem čo myslíš, potrebujeme len aby videl vo VBE personal.xls...

Zdravím, pokouším se řešit stejný problém. Při spuštění tohoto makra mi to hodí chybovou hlášku: Run time error '1004': Method 'Copy of object'_Worksheet failed

Potřebuju pouze rozhodit jednotlivé listy na samostatné soubory s názvem listu.

Doplněk taky nefunguje?

Píše vyskytla sa neočekávaná chyba

V tom případě budeš muset uvést víc informací.
Verze excelu, kde je soubor umístěn atd.

Soubor je verze 97-2003
ja mam office 2007
soubor sem zkopíroval z flashky do slozky na plochu
ulozil ho jako xlsm s podporou maker
pak vyzkoušel jak postup s vytvořením makra tak vámi vytvořený doplněk. Bohužel se pokaždé vyskytla nějaká chyba.
V makru mi to vysvítí chybu v řádku (když kliknu na debug): ws.copy

1)Stáhni doplněk na plochu.
2)Ulož soubor na plochu - neměň koncovku nechej *.xls
3)poklepáním spusť doplněk
4)otevři svůj soubor
5)ve svém souboru na záložce doplňky spusť makro - Listy do souborů

Musí to fungovat vyzkoušeno.

Funguje to na všech souborech, jenom ne na tom co potřebuju udělat :D
Při ukládání to háže upozornění na Nevýznamná ztráta věrnosti.

To znamená, že se listy do souborů neuloží?
Co se stane, když zdrojový soubor "přeuložíš" do formátu *.xlsx a poté použiješ doplněk?

Původní formát i přeuložený do xlsx háže stejnou chybovou hlášku: Vyskytla sa neočekávaná chyba.

Ten doplněk funguje správně, něco je zle v tom zdrojovém sešitu. Nechám si ho poslat znovu. Blbli tam nějak se zamčeným/odemčeným souborem. Když v něm zadám jednoduché makro (přes záznam) pro vyplnění buňky číslem a barvou tak to funguje na všech listech. Ale jakmile jsem zkusil přes záznam udělat makro na uložení listů do jednotlivých souborů, že si to po jednotlivých listech proklikám, tam už se to makro seklo a háže chybu (asi při kopírování daného listu).

Ahoj,
pokiaľ mu to vypísalo "Vyskytla sa neočakávaná chyba" v slovenčine, tak je tá hláška súčasťou môjho makra a nie systémové hlásenie Excelu. (Má preklep, na základe ktorého sa nedá povedať, či má tú hlášku v češtine alebo slovenčine, má to napísané federálne - česko-slovensky "Vyskytla sa neočekávaná chyba" )
Proste som sa vtedy nezaoberal ďalším ošetrovaním toho, aké druhy chýb sa vo všeobecnosti môžu vyskytnúť... Malo by to fungovať bez problémov za predpokladu, že v zdroji nie sú žiadne "špeciality", napr. poskrývané či pouzamykané hárky...
Ako prvé by som skúsil z môjho makra vyhodiť On Error GoTo Chyba a na základe takto obdržanej hlášky by šlo testovať, aký druh chyby nastal... Teda... ak robí vôbec s našim doplnkom...
Mám totiž obavy, či nehovoríme o odlišných veciach - akoby nepoužíval ten "náš" doplnok - v ňom totiž žiadny zápis ws.copy neexistuje!?!

Ťažko takto povedať...

Dawa používaš doplnok, ktorý sem postol Siki 16.1.2016 o 21:56???

v doplnku se na makro nedostanu. v nem se mi pouze zobrazi chybova hlaska a soubory se nerozdeli.

ta chyba ws.copy je kdyz sem se pokousel nastavit vyse uvedene makro. tam to nekde je.

Makro z doplňku

Sub SheetsToFiles()
    On Error GoTo Chyba
    Application.ScreenUpdating = False
    Zdroj = ActiveWorkbook.Name
    Cesta = ActiveWorkbook.Path & "\"
    For i = 1 To ActiveWorkbook.Sheets.Count
        Meno = Sheets(i).Name '& ".xlsx"
        Sheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=Cesta & Meno
        ActiveWindow.Close
        Workbooks(Zdroj).Activate
    Next i
    Application.ScreenUpdating = True
    MsgBox "Vytvorenie samostatných súborov z hárkov súboru " & Zdroj & " bolo úspešne ukončené." & Chr(13) & "Nové súbory sú uložené v zložke " & Cesta, vbInformation, "Oznam"
    Exit Sub
Chyba:
    MsgBox "Vyskytla sa neočakávaná chyba", vbCritical, "Chyba"
End Sub

...sorry sekol som sa, myslel som doplnok od Sikiho zo 17.1.2016...

Tak ešte raz, lebo fakt neviem, o ktorej verzii píšeme...

1. stiahni si súbor od Sikiho zo 17.1.2016 13:12 (viď nižšie) napr na plochu
2. spusti si svoj súbor, ktorý chceš po hárkoch poukladať do súborov
3. v Exceli 2007 choď na: Možnosti programu Excel-Doplnky a tam dole daj Spustiť (Doplnky programu Excel), tam v okne Doplnky, ktoré sa Ti otvorí, stlač Prehľadávať, nastav si cestu na Sikiho súbor xla, ktorý si stiahol na plochu. Keď ho nájdeš, dvojklik naň a v okne Doplnky Ti pribudne Sikiho doplnok, ktorý sa hneď aj zafajkne. Dáš OK a tým to je hotové. Nad pásom nástrojov sa v Tvojom súbore automaticky objaví nová karta Doplnky. Choď na ňu a v páse nástrojov klikni na Sikiho doplnok. Tým sa makro spustí a vykoná, t.j. vyrobí x súborov, ktoré sú kópiami hárkov Tvojho súboru.

Robíš to tak?

Ahoj, už mi to psal výše, že doplněk funguje jen né na tom souboru který potřebuje.
Pokud rozdělení listů do souborů je jednorázová akce není třeba doplněk "vkládat do Excelu" ale pouze spustit poklepem na soubor a k tomu si otevřít soubor, který chceme "dělit".

Někde výše psal/a

Ten doplněk funguje správně, něco je zle v tom zdrojovém sešitu. Nechám si ho poslat znovu. Blbli tam nějak se zamčeným/odemčeným souborem. Když v něm zadám jednoduché makro (přes záznam) pro vyplnění buňky číslem a barvou tak to funguje na všech listech. Ale jakmile jsem zkusil přes záznam udělat makro na uložení listů do jednotlivých souborů, že si to po jednotlivých listech proklikám, tam už se to makro seklo a háže chybu (asi při kopírování daného listu).

Bohužel se mi to nepodařilo nasimulovat. I když sem listy i soubor pozamykal (bez hesla) tak rozdělení do souborů proběhlo korektně.

Áno, to som čítal, ale ako vravím, nevedel som sa v tom jednoznačne orientovať ako to myslí, aj preto som to napísal radšej ešte raz a polopatisticky...

A áno, aj pri uzamknutých hárkoch to musí šlapať, dá sa urobiť kópia uzamknutého hárka, čo je podľa mňa trocha prúser, aj keď ma to už párkrát zachránilo pri zabudnutom hesle .

Makro som trocha upravil, no najlepšie by bolo, keby mohol ten súbor proste poskytnúť...

Sub SheetsToFiles()
    On Error GoTo Chyba
    i=0
    Application.ScreenUpdating = False
    Zdroj = ActiveWorkbook.Name
    Cesta = ActiveWorkbook.Path & "\"
    For i = 1 To ActiveWorkbook.Sheets.Count
        Meno = Sheets(i).Name
        Sheets(i).Copy
        ActiveWorkbook.SaveAs Filename:=Cesta & Meno
        ActiveWindow.Close
        Workbooks(Zdroj).Activate
    Next i
    Application.ScreenUpdating = True
    MsgBox "Vytvorenie samostatných súborov z hárkov súboru " & Zdroj & " bolo úspešne ukončené." & Chr(13) & "Nové súbory sú uložené v zložke " & Cesta, vbInformation, "Oznam"
    Exit Sub
Chyba:
    MsgBox "Vyskytla sa chyba pri indexe " & i, vbCritical, "Chyba"
    If i <> 0 Then MsgBox "Problematický hárok: " & Meno, vbCritical, "Chyba"
End Sub

Pánové díky za pomoc. Bohužel soubor poskytnout nemohu (neměl bych ho mít ani já :D)
Problém sic nevyřešen, chyba vyskakuje i v originálním souboru beze změn, ale stal se z toho problém někoho jiného. Všem díky za snahu.

Tak problém vyřešen, v datovém souboru byl skrytý list, o kterém mi nikdo neřekl, po odkrytí vše funguje jak má. Ještě jednou děkuji za poskytnutou podporu.

Nejak to tu stíchlo...

Ak je to pre niekoho ešte zaujímavé, potom pridávam tento link, kde je návod ako pridať
ponuku/tlačítko na panel rýchleho spustenia. Postup je tam pre 2007/2003 v 2010 je to podobné

Vyskúšal som to v Exceli 2010 a funguje to:
1. Otvorím Excel (netreba otvárať žiadny súbor)
2. Vytvorím makro - napríklad môj postup vyššie s mojim makrom (treba makro trošku upraviť...)
3. Zatvorím okno MVB for Aplication... - prepnem sa späť do Excelu
4. Postupujem podľa návodu z odkazu
5. Ukončím Excel - netreba ukladať nič...
6. Opäť otvorím Excel - ponuka - tlačítko na paneli je tam - makro funguje...

P.S. ak bude záujem - vytvorím podrobný obrázkový návod aj s "pokecom" - ale len pre Excel 2010 - inú verziu nemám...

Všem se omlouvám, něco důležitějšího nyní "ruší mé kruhy". Neberte to prosím jako nezájem, problém budu ale dál řešit nejdřív zítra odpoledne. Zúčastněným zatím děkuju.

Pánové nebylo by jednodušší použít doplněk?

Použil sem kód od Roberta

Pánové nebylo by jednodušší použít doplněk?

jednoznačne! najrýchlejšia a najjednoduchšia cesta.

Paráda!
Myslel som, že bude najprv treba v nastaveniach excelu pridať a aktivovať doplnok, ale takto je to veľmi šikovné.
Predpokladám však, že na 2003 mu to nepôjde, keďže ribbony sú kapitola sama osebe... či?

Rozhodne si tento štýl zavediem v práci, potom bude normálka radosť chodiť do práce

Tak sem právě otestoval doplněk na office xp a je funkční. Jen vytváří "zdvojenou" koncovku souboru (List1.xlsx.xls)

Přikládám upravený soubor.

To je přesně ono, co jsem potřeboval. Sorry, že jsem se dlouho ve svém vlákně neobjevil, ale měl jsem poněkud větší starosti. Všem zúčastněným patří můj nehynoucí dík . Značím solved.