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

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...

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.

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.