Sub BlattSpeichern()
Dim sPath As String, sWks As String, sFile As String
Dim index%
On Error GoTo ErrH
sPath = Application.DefaultFilePath
If (Right(sPath, 1) <> "\") Then sPath = sPath & "\"
sWks = InputBox(prompt:="Blattname", _
Default:=BLATTNAME$)
If ((sWks = "") Or _
(InStr(1, sWks, ":") > 0) Or _
(InStr(1, sWks, "\") > 0) Or _
(InStr(1, sWks, "/") > 0) Or _
(InStr(1, sWks, "?") > 0) Or _
(InStr(1, sWks, "*") > 0) Or _
(InStr(1, sWks, "[") > 0) Or _
(InStr(1, sWks, "]") > 0) Or _
(Len(sWks) > 31)) Then sWks = BLATTNAME$
sFile = InputBox(prompt:="Dateiname", _
Default:=sPath & DATEINAME$ & ".xls")
ActiveSheet.Copy
ActiveSheet.Name = sWks
ActiveWorkbook.SaveAs sFile
MsgBox "Tabelle kopiert als : " & sWks & vbCrLf & _
"In Verzeichniss : " & ActiveWorkbook.Path & vbCrLf & _
"Mit dem Namen : " & ActiveWorkbook.Name, vbInformation
Exit Sub
ErrH:
' falls versucht datei mehrmals mit dem selben namen in den selben verz.
' zu speichern -> exception 1004 -> neue dateineme := dateiname + index% -> neuer versuch datei zu speichern
If (Err.Number = 1004) Then
If (index% < 1000) Then
index% = index% + 1
sFile = sPath & DATEINAME$ & index% & ".xls"
Resume
Else
MsgBox "Variable index% zu Hoch!", vbCritical: End
End If
Else
MsgBox "Laufzeitfehler : " & vbCrLf & Err.Description & vbCrLf & "Fehlernummer : " & Err.Number, vbCritical
End If
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen