Zeilen kopieren

Sub Test()
Dim Tab1 As Worksheet, Tab2 As Worksheet
Dim i As Long, y As Long, x As Long
Dim Zelle As Range
Worksheets("Sheet1").Activate
Worksheets("Sheet2").Activate
For x = 1 To Worksheets("Sheet1").UsedRange.Columns.Count 'Erste drei Zeilen kopieren
If Worksheets("Sheet1").Cells(x, 1).Value <> "" Then
y = 1
Do Until Worksheets("Sheet2").Cells(y, 1) = ""
y = y + 1
Loop
Worksheets("Sheet2").Cells(1, x) = Worksheets("Sheet1").Cells(1, x).Value
Worksheets("Sheet2").Cells(2, x) = Worksheets("Sheet1").Cells(2, x).Value
End If
Next x
End Sub