VBA-Beispiel 060
mail schreiben
mail schreiben

alle Tabellen als Datei speichern
Jede Tabelle einer Datei als neue Datei speichern
Dateiname ist jeweils der Tabellenname
Sub Tabellen_in_neue_Dateien_kopieren()
'jede Tabelle dieser Datei als neue Datei speichern
'Dateiname ist jeweils der Tabellenname
Dim Pfad As String  
Dim wks As Worksheet  

'Pfad anpassen
Pfad = "C:\Eigene Dateien\"
'Pfad = ThisWorkbook.Path & "\"

'prüfen ob Pfad existiert
If Dir(Pfad) = "" Then
  MsgBox "Pfad existiert nicht", , "Abbruch"
  Exit Sub  
End If

On Error GoTo Fehler

Application.ScreenUpdating = False
'eventuell schon vorhandene Datei ohne Rückfrage überschreiben
Application.DisplayAlerts = False

For Each wks In ThisWorkbook.Worksheets  
    ThisWorkbook.Worksheets(wks.Name).Copy
    ActiveWorkbook.SaveAs (Pfad & wks.Name)
    ActiveWorkbook.Close
Next wks

Application.DisplayAlerts = True
Application.ScreenUpdating = True

MsgBox "alle Tabellen gespeichert in" & vbNewLine & vbNewLine _
        & Pfad, , ""

Exit Sub

Fehler:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
    & "Beschreibung: " & Err.Description _
    , vbCritical, "Fehler"
End Sub
Download:   vba060.zip
relevante Links:

top