Sub
Datenübertragung()
Dim
Zeile
As
Long
Dim
ZeileMax
As
Long
Dim
n
As
Long
With
Daten
ZeileMax = .UsedRange.Rows.Count
n = 1
For
Zeile = 2
To
ZeileMax
.Range(
"A"
& Zeile).Copy Destination:=Maske.Range(
"A2"
)
.Range(
"B"
& Zeile).Copy Destination:=Maske.Range(
"D7"
)
.Range(
"C"
& Zeile).Copy Destination:=Maske.Range(
"H4"
)
.Range(
"D"
& Zeile).Copy Destination:=Maske.Range(
"A18"
)
Application.DisplayAlerts =
False
ActiveWorkbook.SaveAs (
"C:\Test Speicherort\" & "
NAME_" & Zeile - 1 & _
Format(Day(
Date
),
"00"
) & Format(Month(
Date
),
"00"
) & Year(
Date
) & _
".xlsx"
), FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts =
True
n = n + 1
Next
Zeile
End
With
End
Sub