Datei automatisch im Monatsordner speichern

[Turbo123]

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

[Kuwer]

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

[Turbo123]

Hallo Uwe,

SUPER!!!!

das ist genau das, wonach ich suchte, vielen herzlichen Dank!!

Gruss Hubert

[Turbo123]

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

[Kuwer]

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

[snb]

Und erstens: trenne deine Daten nicht !

[Turbo123]

Hallo Uwe,

vielen Dank für deine Hilfe, passt super!!!!

Gruss Hubert

[ludof]

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??

[Kuwer]

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

[ludof]

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