Suche nach einem Code, die in Tabelle 1 die spalte A prüft und wenn nicht leer, dann werden die Werte von Spalte A, B, C, D aus der gleichen Zeile in Tabelle 2 kopiert, dann wird die nächste Zeile geprüft (Schleife) und durchgeführt bis in Spalte A, eine Zelle leer ist. Spalte A sind Alphanumerische Daten, Spalte B sind Nummerische Daten, Spalte C sind Alphanummerische Daten und Spalte D sind Alphabetische Daten. Vielen Dank
Sub kopieren() Dim i As Long Dim j As Long Dim k As Long i = Worksheets("Tabelle1").Range("A" & Rows.Count).End(xlUp).Row For j = 1 To i If Cells(j, 1).Value "" Then k = Worksheets("Tabelle2").Range("A" & Rows.Count).End(xlUp).Row + 1 Worksheets("Tabelle1").Range(Cells(j, 1), Cells(j, 4)).Copy _ Destination:=Worksheets("Tabelle2").Cells(k, 1) Else Exit Sub End If Next j End Sub Damit klappt es in meinem Workbook. Es wird nur kopiert bis die erste Zelle in Spalte A leer ist, auch wenn danach noch Zellen mit alphanumerischen Daten folgen.
Suche nach einem Code, die in Tabelle 1 die spalte A prüft und wenn nicht leer, dann werden die Werte von Spalte A, B, C, D aus der gleichen Zeile in Tabelle 2 kopiert, dann wird die nächste Zeile geprüft (Schleife) und durchgeführt bis in Spalte A, eine Zelle leer ist.
Spalte A sind Alphanumerische Daten, Spalte B sind Nummerische Daten, Spalte C sind Alphanummerische Daten und Spalte D sind Alphabetische Daten.
Vielen Dank
Sub kopieren()
Dim i As Long
Dim j As Long
Dim k As Long
i = Worksheets("Tabelle1").Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To i
If Cells(j, 1).Value "" Then
k = Worksheets("Tabelle2").Range("A" & Rows.Count).End(xlUp).Row + 1
Worksheets("Tabelle1").Range(Cells(j, 1), Cells(j, 4)).Copy _
Destination:=Worksheets("Tabelle2").Cells(k, 1)
Else
Exit Sub
End If
Next j
End Sub
Damit klappt es in meinem Workbook. Es wird nur kopiert bis die erste Zelle in Spalte A leer ist, auch wenn danach noch Zellen mit alphanumerischen Daten folgen.