Option
Explicit
Option
Base 1
Sub
Kopieren()
Dim
Spalten: Spalten = Array(1, 3, 6, 9, 12)
Dim
Quellblatt
As
Object
, Zielblatt
As
Object
Set
Quellblatt = ThisWorkbook.Sheets(
"Tabelle1"
)
Set
Zielblatt = ThisWorkbook.Sheets(
"Tabelle2"
)
Dim
ZeileFirst
As
Long
Dim
Inhalte()
As
Variant
Dim
CanCopy
As
Boolean
Dim
i, j
ReDim
Inhalte(UBound(Spalten))
ZeileFirst = WorksheetFunction.Max(2, Zielblatt.Cells(Rows.Count, 1).
End
(xlUp).Row)
With
Quellblatt
For
i = 1
To
8
CanCopy =
False
For
j = 1
To
UBound(Spalten)
If
.Cells(i, Spalten(j)).Text <>
""
Then
CanCopy =
True
Inhalte(j) = .Cells(i, Spalten(j)).Value
Else
Inhalte(j) =
""
End
If
Next
j
If
CanCopy
Then
For
j = 1
To
UBound(Spalten)
Zielblatt.Cells(ZeileFirst, j) = Inhalte(j)
Next
j
ZeileFirst = ZeileFirst + 1
End
If
Next
i
End
With
End
Sub