Tabelle unter Tabellenblattname ablegen
19.08.2021 14:40:06
Roland
Ich habe eine Datei die ich für das Erstellen von Offerten benötige. Die Datei erstellt aus einer Vorlage Offerten, die in fortlaufender Nummerierung als zusätzliches Tabellenblatt in demselben File abgelegt werden.
Dies wird immer wie unübersichtlicher, deshalb soll die Offerte neu direkt in einen Ordner abgelegt werden. Es muss nun geprüft werden ob es den Ordner und seine Unterordner bereits gibt. Wenn nicht, sollen die Ordner zuerst erstellt werden bevor dann das Tabellenblatt als eigenes Worksheet abgelegt wird.
Mit dem Makro Recorder konnte ich das Grundgerüst für die Ablage erstellen. Allerdings sind nun weder Ablageort noch Dateiname variabel. Der Name des Tabellenblatts lautet in diesem Fall "2021-0001", sprich Jahr und fortlaufende Nummer.
Der Ablageort und Dateiname sollte variabel entsprechend zum Namen des Tabellenblatts angepasst werden. Zudem sollte die neue Datei nicht geschlossen werden sondern offen bleiben.
Grüsse, Roland
Sub Tabellenblatt_ablegen()
'Ablagestruktur prüfen und erstellen
If Dir("\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2021-0001", vbDirectory) = "" Then
MkDir ("\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2021-0001")
Else
End If
If Dir("\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2021-0001\01_Offerte", vbDirectory) = "" Then
MkDir ("\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2021-0001\01_Offerte")
Else
End If
If Dir("\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2021-0001\02_Rechnung", vbDirectory) = "" Then
MkDir ("\\CH_N\31_Projekte\\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2021-0001\02_Rechnung")
Else
End If
'Tabellenblatt in neue Datei verschieben
ActiveSheet.Move
ChDir _
"\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2222-0001"
'Tabellenblatt speichern in Zielordner
ActiveWorkbook.SaveAs Filename:= _
"\\CH_N\31_Projekte\02 Vertrag\05 Accounting\02 Once Only\02 Offerten\2222-0001\2222-0001.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub