Sub
Übernahme()
Application.ScreenUpdating =
False
With
ThisWorkbook.Worksheets(
"Quelle_Sheet1"
)
.Range(
"$A$1:$JH$14"
).AutoFilter Field:=1, Criteria1:=
"<>"
With
.AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
Workbooks(
"Ziel_Datei.xml"
).Worksheets(
"Ziel_Datei_Sheet1"
).Range(
"A1"
).PasteSpecial Paste:=xlPasteValues
End
With
.Range(
"AM2:BT"
& .Cells(.Rows.Count,
"AM"
).
End
(xlUp).Row).Copy
Workbooks(
"Ziel_Datei.xml"
).Worksheets(
"Ziel_Datei_Sheet2"
).Range(
"A9"
).PasteSpecial Paste:=xlPasteValues
.Range(
"CP2:HG"
& .Cells(.Rows.Count,
"CP"
).
End
(xlUp).Row).Copy
Workbooks(
"Ziel_Datei.xml"
).Worksheets(
"Ziel_Datei_Sheet3"
).Range(
"A9"
).PasteSpecial Paste:=xlPasteValues
.Range(
"HM2:IW"
& .Cells(.Rows.Count,
"HM"
).
End
(xlUp).Row).Copy
Workbooks(
"Ziel_Datei.xml"
).Worksheets(
"Ziel_Datei_Sheet4"
).Range(
"A9"
).PasteSpecial Paste:=xlPasteValues
End
With
Application.CutCopyMode =
False
End
Sub