mein Problem ist ich möchte aus einer bestehenden Arbeitmappe eine einzelne Tabelle Speichern .
cu Michael
Sheets("Tabelle1").Copy 'Blatt in neue Mappe kopieren
With ActiveWorkbook
.SaveAs Filename:="DeinneuerName.xls"
.Close
End With
Const NumFormat = "000" ' 3stellige Anzeige
Private Sub CommandButton1_Click()
Dim pfad As String, nr As String
pfad = "D:\xl\Michael\" 'letzten Slash nicht vergessen
Sheets("Banf").Copy 'Blatt in neue Mappe kopieren
nr = Format(HöchsterIndex(pfad, ActiveSheet.Range("E7")) + 1, NumFormat)
With ActiveWorkbook
.SaveAs Filename:=pfad & ActiveSheet.Range("E7") & "_" & nr & ".xls"
.Close
MsgBox "gespeichert als '" & pfad & ActiveSheet.Range("E7") & "_" & nr & ".xls'"
End With
End Sub
'fn: Name der Datei ohne Nummer
Function HöchsterIndex(pfad As String, fn As String) As Integer
Dim i As Integer
i = 0
Do
i = i + 1
Loop Until Dir(pfad & fn & "_" & Format(i, NumFormat) & ".xls") = ""
HöchsterIndex = i - 1
End Function