Folgendes Makro hat die Aufgabe alle Artikelnummern von Tabelle 1 Spalte A in Tabelle 2 Spalte A zu kopieren (komplette Zeile), die z.B. 3 mal vorkommen.
Problem 1: Die erste Zeile darf nicht berücksichtigt werden, also erst die Artikelnummern ab A2
Problem 2: Wenn keine Artikelnummern gefunden wurden, soll ein Hinweis in MsgBox erscheinen. Z.Zt. erscheint die MsgBox bei jedem Durchgang.
Sub DatensätzeSuchen()
Dim rng As Range, rCell As Range
Dim iRow As Integer
Set rng = Range("A2").CurrentRegion
For Each rCell In rng.Columns(1).Cells
If WorksheetFunction.CountIf(rng.Columns(1), rCell.Value) = 3 Then
iRow = iRow + 1
rng.Rows(rCell.Row).Copy Destination:=Sheets("Tabelle2").Range("A2"). _
Cells(iRow, 1)
End If
Next rCell
If IsEmpty(Range("A2")) = 0 Then
Beep
MsgBox "Keine Datensätze gefunden!"
Else
Columns.AutoFit
End If
End Sub
Vielen Dank im voraus
Rolf