Option
Explicit
Public
Sub
Übertragen()
Dim
loLetzte
As
Long
, i
As
Long
, z
As
Long
Dim
varArray()
As
Variant
Application.ScreenUpdating =
False
With
Worksheets(
"Eingabe"
)
loLetzte = .Cells(.Rows.Count,
"B"
).
End
(xlUp).Row
ReDim
varArray(loLetzte)
For
i = 2
To
loLetzte
If
.Cells(i,
"B"
) <>
""
Then
varArray(z) = .Cells(i,
"C"
)
z = z + 1
End
If
Next
i
.Range(.Cells(2,
"C"
), .Cells(loLetzte,
"C"
)).ClearContents
End
With
With
Worksheets(
"Daten"
)
.Range(
"A"
& .Cells(.Rows.Count,
"A"
).
End
(xlUp).Offset(1).Row) _
.Resize(, loLetzte) = varArray
End
With
End
Sub