Sub
Tabellen()
Dim
strPfad
As
String
Dim
wksBlatt
As
Worksheet
Dim
wkbZiel
As
Workbook
Application.ScreenUpdating =
False
Application.DisplayAlerts =
False
strPfad =
"\\MeinPfad\EgalOrdner"
& Year(
Date
) & "\"
If
Dir(strPfad, vbDirectory) =
""
Then
MkDir strPfad
End
If
Set
wksBlatt = ThisWorkbook.Worksheets(
"Test1"
)
ThisWorkbook.Worksheets(
"Test1"
).Copy
wkbZiel = ActiveWorkbook
wkbZiel.SaveAs strPfad & Environ(
"Username"
) &
""
& Now
wkbZiel.Close savechanges:=
False
Application.DisplayAlerts =
True
Application.ScreenUpdating =
True
End
Sub