AW: Zeilen löschen, nach filtertext
28.09.2016 15:32:57
Michael
Hey, habe jetzt eine Lösung gefunden die ohne Svwerweis funktioniert:
Sub Datenabgleich()
Application.ScreenUpdating = False
'letzte Zeilen auslesen
Dim lastRowKlick As Long
lastRowKlick = Worksheets("Klick").Range("A" & Rows.Count).End(xlUp).Row
Dim lastRowMedia As Long
lastRowMedia = Worksheets("Media").Range("A" & Rows.Count).End(xlUp).Row
Dim lastRowZiel As Long
lastRowZiel = Worksheets("Ziel").Range("A" & Rows.Count).End(xlUp).Row
'namen aus klick auslesen
Dim i As Long
For i = 2 To lastRowKlick
Dim vorname, nachname As String
vorname = Worksheets("Klick").Cells(i, 2).Value
nachname = Worksheets("Klick").Cells(i, 3).Value
'nur wenn beides nicht leer ist
If vorname "" And nachname "" Then
'namen aus media auslesen
Dim j As Long
For j = 2 To lastRowMedia
'namensvergleich
If vorname = Worksheets("Media").Cells(j, 1).Value And nachname = Worksheets(" _
Media").Cells(j, 2).Value Then
'werte kopieren
lastRowZiel = lastRowZiel + 1
Worksheets("Ziel").Cells(lastRowZiel, 1) = Worksheets("Klick").Cells(i, 1). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 2) = Worksheets("Klick").Cells(i, 2). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 3) = Worksheets("Klick").Cells(i, 3). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 4) = Worksheets("Klick").Cells(i, 4). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 5) = Worksheets("Klick").Cells(i, 5). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 6) = Worksheets("Klick").Cells(i, 6). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 7) = Worksheets("Klick").Cells(i, 7). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 8) = Worksheets("Klick").Cells(i, 8). _
Value
Worksheets("Ziel").Cells(lastRowZiel, 9) = Worksheets("Media").Cells(j, 4). _
Value
End If
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
Danke für eure Mühen
LG Micha