Makro: verschiedene Werte suchen und kopieren
08.05.2015 14:01:45
Hilfesucher
Ich habe ein kleines VBA Problem und komme nicht weiter.
Zum Hintergrund, ich habe eine Tabelle die ca 11.000 Zeilen hat.Ich möchte diese Zeilen an einer ID identifizieren die in Spalte I steht(eine ID kommt mehrmals vor)und dann in ein neues Blatt kopieren
In dem rohen Datensatz gibt es ca 50 verschiende IDs von denen mich allerdings nur ca 30 interessieren. Jetzt könnte ich einfach über den Filter jedesmal die ausblenden die mich nicht interessieren, da ich diesen Vorgang allerdings fast täglich wieder hole bzw berichten muss und sich die Daten ändern, würde ich dies gern automatisieren mit einem Makro.
Bisher bin ich mit meinem Makro soweit, dass ich für eine ID die Zeilen auslessen kann und in ein neues Blatt kopieren kann(in meinem fall die 1001. Kann mir jemand helfen wie ich die anderen 31 IDs einfügen kann, ohne dass sich das Makro bis ins unendliche aufbläht?
Sub FindenUndKopieren()
Dim rng As Range
Dim loDeinWert As Long
Dim sFirstAdress As String
loDeinWert = "1001" 'gesuchter Wert
Set rng = Worksheets("1").Range("I:I").Find(loDeinWert)
If rng Is Nothing Then
MsgBox "Wert " & loDeinWert & " nicht gefunden!"
Else
sfirstaddress = rng.Address
Do
rng.EntireRow.Copy
Worksheets("2").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll
Set rng = Worksheets("1").Range("I:I").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address sfirstaddress
End If
End Sub
Fred