Hallo zusammen,
für folgende Aufgabe bräuchte ich Hilfestellung! (die Googlesuche hat mir nicht wirklich geholfen)
Ich speichere meine Tabellenblätter mit folgendem Makro:
Sub SpeichernUnterHG()
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:="Z:\Test\TestGegenstaende\Test_" & Range("B3").Value & "_" & Format(Now, "DD_MMM_YYYY_hhmm") & ".xlsx"
ActiveWorkbook.Close
end sub
Dieses makro möchte ich dahingehend erweitern, dass mir alle Dateien mit Datum Januar(Febr.,März……..), automatisch in einen entsprechenden Ordner Januar(Februar....) kopiert werden.
Ich hoffe, ich hab das einigermaßen verständlich beschrieben.
Für Vorschläge wäre ich euch dankbar!
Gruss turbo123
Hallo,
Sub SpeichernUnterHG()
Dim strM As String, strV As String
strV = "Z:\Test\TestGegenstaende\"
strM = Format(Date, "MMMM")
If Dir(strV & strM, vbDirectory) <> strM Then MkDir strV & strM
ActiveSheet.Copy
ActiveWorkbook.Close True, strV & strM & "\Test_" & Range("B3").Value & "_" & Format(Now, "DD_MMM_YYYY_hhmm") & ".xlsx"
End Sub
Gruß Uwe
Hallo Uwe,
SUPER!!!!
das ist genau das, wonach ich suchte, vielen herzlichen Dank!!
Gruss Hubert
Hallo Uwe,
vielleicht kannst du mir ein weiteres mal helfen und zwar möchte ich dieses Skript um einen Unterordner erweitern, d.h. beim speichern des Monats möchte ich noch einen Unterordner mit erstellen!
hab das Skript abgeändert, aber irgendwie klappt das nicht!!
Sub SpeichernUnterMonatRG()
Dim strM As String, strV As String
strV = "Z:\Test\TestGegenstände\"
strM = Format(Date, "MMMM")
If Dir(strV & strM & "\Testordner\", vbDirectory) <> strM Then MkDir strV & strM & "\Testordner\"
ActiveSheet.Copy
ActiveWorkbook.Close True, strV & strM & "\Test_" & Range("B3").Value & "_" & Format(Now, "DD_MMM_YYYY_hhmm") & ".xlsx"
End Sub
Gruß Hubert
Hallo Hubert,
einfach schön eins nach dem anderen.
Sub SpeichernUnterHG()
Dim strM As String, strV As String
strV = "Z:\Test\TestGegenstaende\"
strM = Format(Date, "MMMM")
If Dir(strV & strM, vbDirectory) <> strM Then
MkDir strV & strM
MkDir strV & strM & "\Testordner"
End If
ActiveSheet.Copy
ActiveWorkbook.Close True, strV & strM & "\Test_" & Range("B3").Value & "_" & Format(Now, "DD_MMM_YYYY_hhmm") & ".xlsx"
End Sub
Gruß Uwe
Und erstens: trenne deine Daten nicht !
Hallo Uwe,
vielen Dank für deine Hilfe, passt super!!!!
Gruss Hubert
Hallo Uwe
Dein letzter Code gefällt mit sehr sehr gut.
Aber ändere ich dein Code um das er nicht eine xlsx sondern eine xlsm Datei speichert??
Hallo ludof,
Sub SpeichernUnterHG()
Dim strM As String, strV As String
strV = "F:\Uwe\Documents\Excel\Test\"
strM = Format(Date, "MMMM")
If Dir(strV & strM, vbDirectory) <> strM Then
MkDir strV & strM
MkDir strV & strM & "\Testordner"
End If
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=strV & strM & "\Test_" & Range("B3").Value & "_" & Format(Now, "DD_MMM_YYYY_hhmm"), FileFormat:=52
ActiveWorkbook.Close
End Sub
Siehe dazu auch hier:
https://docs.microsoft.com/de-de/office/...ook.saveas
Gruß Uwe
Hallo Uwe
Sorry für die späte Rückmeldung. Dein läuft nun wie ich es brauche.
Nochmals vielen lieben Dank für deine perfekte Hilfe