saveas speichert nicht
TobiasS
Ich habe ein Problem und hoffe jemand kann mir helfen, ich weiss nämlich nicht mehr weiter.
Ich habe eine Arbeitsmappe mit etlichen Tabellen. 2 aufeinanderfolgende Tabellen sollen in eine neue Arbeitsmappe gespeichert werden. Hier habe ich für alle Tabs eine Schleife.
Das Makro läuft auch durch, wenn ich eine "frische Arbeitsmappe" aufmache (man muss aber eine gerade Anzahl an worksheets haben. das das dies bei mir immer der fall ist, habe ich hier nichts für ungerade eingebaut).
Angewandt soll das makro werden auf arbeitsblätter in denen logos usw. drin sind. Hier läuft das makro nicht!!!
Ich bekomme immer die Fehlermeldung "Laufzeitfehler 1004: dokument wurde nicht gespeichert". Und verweist auf die codezeile:
.SaveAs FolderName _
& "\" & Destwb.Sheets(1).Name & FileExtStr, _
FileFormat:=FileFormatNum
.Close False
Besonders komisch. Er erstellt mir die erste Mappe mit den ersten zwei Sheets (kann diese aber ja nicht speichern). Wenn ich nun versuche manuell zu speichern gibt er mir keine Fehlermeldung aus und läßt mich die Datei speichern, speichert aber nichts. Auch nicht unter einem anderen Namen.
Ist vielleicht was am code falsch, ich sehe das irgendwie nicht (läuft ja auch mit einer "normalen" mappe) und gibt es vielleicht eine alternative zu dem "saveas"-befehl, den ich versuchen könnte?
danke schonmal fürs durchlesen, ich hoffe das war nicht zu verwirrend!
viele grüße
tobi
Sub create_workbooks()
Dim i As Integer
Dim wbSource As Workbook
Dim intI As Integer
Dim arrSheet(1 To 2) As Integer
Dim DateString As String
Dim FolderName As String
Dim Destwb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
'löschen nicht benötigter worksheets
Call cleaner
'sortierung der worksheets nach benötigter reihenfolte
Call SortWorksheets
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
Set wbSource = ThisWorkbook
'Ordnername bestimmen, in den die neuen Mappen erstellt werden.
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = wbSource.Path & "\" & "Reports" & wbSource.Name & "" & DateString
MkDir FolderName
'immer 2 Tabellen in eine Mappe kopieren
For intI = 1 To wbSource.Sheets.Count Step 2
arrSheet(1) = intI
arrSheet(2) = intI + 1
wbSource.Sheets(arrSheet).Copy
Set Destwb = ActiveWorkbook
'fileformat festlegen
With Destwb
Select Case wbSource.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .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 With
With Destwb
.SaveAs FolderName _
& "\" & Destwb.Sheets(1).Name & FileExtStr, _
FileFormat:=FileFormatNum
.Close False
End With
Next intI
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub