Bedingtes kopieren von ganzen Zeilen
29.02.2008 09:52:58
ganzen
ich habe unten stehenden Code, der leider nicht den gewünschten Erfolg bringt.
Hat einer eine Idee, was hier falsch läuft?
Folgendes soll der Code bewirken:
Tabelle 3 soll in Reihe H (ab Zeile 4) nach Werten durchsucht werden, die in Tabelle 2 in Reihe A stehen. Es handelt sich um mehrere Werte in Tabelle 2.
Wenn ein Wert üebreinstimmt, soll die komplette Zeile kopiert werden und am Ende der Tabelle 4 eingefügt werden.
Muchas Gracias im Vorraus!
Gruß
Tigha
Private Sub CommandButton2_Click()
Dim Zl As Integer
Dim Zq As Integer
Dim l As Integer
Dim r As Integer
Dim nZeile As Long
With Application
.ScreenUpdating = False
End With
Zl = Sheets(3).UsedRange.Rows.Count
Zq = Sheets(2).UsedRange.Rows.Count
Sheets(3).Activate
ActiveSheet.Range("H4").Select
For l = 4 To Zl
For r = 1 To Zq
If ActiveCell.Value = Sheets(2).Range("A" & r).Value Then
Selection.EntireRow.Copy
With Sheets(4)
.Activate
nZeile = Range("A65536").End(xlUp).Row
End With
Sheets(4).Cells(nZeile + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = xlCopy
End If
Next r
Sheets(3).Activate
Sheets(3).Range("H" & l).Select
Next l
With Application
.ScreenUpdating = True
End With
End Sub