|
Moin Haptum,
vielleicht hilft Dir die folgende Ergänzung schon weiter, bei der zumindest die vorhandenen Einträge nicht mehr überschrieben werden. Voraussetzung ist, dass die erste Spalten nicht leer ist. Sonst könnte man ".Rows.Count, 1)" statt der 1 (Spalte A) eine andere Spalte wählen, z.B. "I", wo immer "Ja" stehen sollte, wenn ich deinen Code richtig verstanden habe.
Es geht wohl erst in Zeile 2 los, aber das ließe sich mit einer kleinen Zusatzabfrage lösen.
VG, Goofy :)
Sub Zeilen_kopieren()
Dim a As Long, i As Long
Application.ScreenUpdating = False
For i = 3 To 300
With Worksheets("Jan").Range("A:I")
If .Cells(i, "I") = "Ja" Then
a = Worksheets("Q1").Cells(Worksheets("Q1").Rows.Count, 1).End(xlUp).Row + 1 'letzte Zeile suchen in der etwas steht (hier in der 1. Spalte)
.Rows(i).Copy Destination:=Worksheets("Q1").Rows(a)
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
|