|
Hallo Megawunk,
Ich habe den Code wie folgt angepasst:
1. die letzte Spalte ist auf Spalte L festgelegt.
2. Es wird geprüft, ob jeweilis der Wert in Spalte L leer ist, falls ja wird die Zeile übersprungen und nicht passiert. Es ist egal, ob die gesamte Spalte oder nur der Wer in Spalte L leer ist.
Falls ja wird die Zeile kopiert und in in Blatt 11 eingefügt.
Sub EintraegeKopieren()
Dim ws As Worksheet
Dim wsTarget As Worksheet
Dim rngSource As Range
Dim i As Integer, j As Integer
Dim lr As Long, lrTarget As Long, col As Long
Set wsTarget = Sheets("11")
For i = 3 To 9
Set ws = Sheets(i)
'Letzte Zeile im Sheet(11) ermitteln
lrTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
With ws
'Letzte Zeile im jeweiligen Sheet ermitteln
lr = .Cells(Rows.Count, 1).End(xlUp).Row
'Prüfen, ob ab Zeile 17 Werte im jeweiligen Sheet stehen
If lr >= 17 Then
'Durchlauf aller Zeilen ab Zeile 17bis zur letzten verwendeten Zeile
For j = 17 To lr
'Prüfen, ob der Wert in Spalte L (12) der aktuellen Zeile leer ist
If Not .Cells(j, 12).Value = "" Then
'aktuelle Zeile kopieren
Set rngSource = .Range(.Cells(j, 1), .Cells(j, 12))
'Einträge kopieren und am Ende in Sheet("11") einfügen
rngSource.Copy Destination:=wsTarget.Cells(lrTarget + 1, 1)
lrTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row
End If
Next j
End If
End With
Next i
End Sub
Ich hoffe, dass dies ist, was Du benötigst.
Viele Grüße
Kai
|