Dim i As Integer
Dim Tabelle1 As Worksheet
Dim Tabelle2 As Worksheet
Dim cell As Range
Set Tabelle1 = ActiveWorkbook.Worksheets("Tabelle1") ' hier anpassen
Set Tabelle2 = ActiveWorkbook.Worksheets("Tabelle2") ' hier anpassen
Set cell = Tabelle1.Cells(4, 1)
i = 6
Do While Not IsEmpty(cell)
'copy
cell.Copy Destination:=Tabelle2.Cells(i, 1)
' increment
i = i + 1
Set cell = cell.Offset(5, 0)
Loop
End Sub
Passe die Tabellen Namen an.
Das Programm wird alle Einträge die in den Zeilen A 4+5N sind kopieren bis eine Zeile leer ist. Das Ziel der kopierten Zellen sind alle Zellen von A6 weg in der Tabelle2. Ich hoffe das hilft.
Flies away!
|