Bitte sehr...
09.08.2016 09:25:18
Michael
Guten Morgen Lena,
...hier Deine zwei Dateien in einem .zip-Archiv - in "LenaB.xlsm" ist das Makro bereits eingepflegt.
Ich hab das Makro auch etwas kommentiert, vielleicht wird Dir dann klarer was ich angepasst habe. Beide Mappen müssen wieder parallel geöffnet sein.
https://www.herber.de/bbs/user/107489.zip
Die Quell-Mappe ("Mappe A") musst Du im Code so bezeichnen, wie sie wirklich heißt. Die Ziel-Mappe ("Mappe B") muss jetzt im Code nicht mehr namentlich spezifiziert werden - diese Mappe ist jetzt als jene Mappe bestimmt, die das Makro enthält.
Der Code nochmal in Reinform:
Sub Vgl()
Dim WbA As Workbook
Dim WbB As Workbook
Dim WsQ As Worksheet
Dim WsZ As Worksheet
Dim rSuch As Range
Dim rNum As Range
Dim r As Range
Dim c As Long
Dim f As Range
'Annahme: BEIDE Mappen (A und B) sind bereits geöffnet
Set WbA = Workbooks("LenaA.xlsx") 'Name Deiner Mappe A
Set WbB = ThisWorkbook 'DIESE Mappe wird als Mappe B bestimmt
Set WsQ = WbA.Worksheets("Tabelle1") 'Quell-Blatt ist 1. Blatt aus A
Set WsZ = WbB.Worksheets("Tabelle1") 'Ziel-Blatt ist 1. Blatt aus B
'Bestimmen wieviele Nummern es in im Quell-Blatt (A) gibt
'Wir suchen ab C13 nach rechts, C13 = Cells(13, 3) (=Zelle(Zeile, Spalte))
With WsQ
Set rNum = .Range(.Cells(13, 3), .Cells(13, 3).End(xlToRight))
End With
'Bestimmen wo die in A gefundenen Nummer in B gesucht werden
'Wir suchen die Nummern ab B13 in Mappe B bis zur letzten gefüllten in B:B
'B13 = Cells(13,2) (=Zelle(Zeile, Spalte))
With WsZ
Set rSuch = .Range(.Cells(13, 2), .Cells(13, 2).End(xlDown))
End With
'Jede Zelle (=Nummer) im Quell-Blatt durchgehen
For Each r In rNum
With WsQ
'Zählen wieviele Einträge darunter zu finden sind
c = WorksheetFunction.Count(.Range(r, .Cells(.Rows.Count, r.Column).End(xlUp))) - 1
End With
With rSuch
'Im o.a. Suchbereich nach der aktuellen Nummer suchen
Set f = .Find(what:=r.Value, LookIn:=xlValues, searchorder:=xlNext)
'WENN die Nummer im Suchbereich gefunden wird...
If Not f Is Nothing Then
With f
'...wird der zu löschende Bereich gewählt und gelöscht
.Offset(1, 0).Resize(c, 1).EntireRow.Delete
End With
End If
End With
Next r
End Sub
Passt?
LG
Michael