Option
Explicit
Public
Sub
kopieren()
Dim
ws
As
Worksheet, loLetzte
As
Long
, loLetzteZiel
As
Long
Application.ScreenUpdating =
False
For
Each
ws
In
ThisWorkbook.Worksheets
Select
Case
ws.Name
Case
"Sammelblatt"
,
"Tabelle5"
Case
Else
With
ws
loLetzte = .Cells(.Rows.Count,
"D"
).
End
(xlUp).Row
Union(.Range(
"D1:D"
& loLetzte), .Range(
"F1:H"
& loLetzte), .Range(
"J1:J"
& loLetzte)).Copy
With
Worksheets(
"Sammelblatt"
)
loLetzteZiel = .Cells(.Rows.Count,
"A"
).
End
(xlUp).Offset(1).Row
If
.Cells(1,
"A"
) =
""
Then
loLetzteZiel = 1
.Range(
"A"
& loLetzteZiel).PasteSpecial Paste:=xlPasteValues
End
With
End
With
End
Select
Next
ws
Application.CutCopyMode =
False
End
Sub