Auswahl aufheben

[Primo Centurio]

Einen wunderschönen guten Sonntag :D

Ich komme meinem Ziel Schritt für Schritt näher, brauche jedoch beim einen oder anderen "Problem" Eure Hilfe.

Die Daten werden mit dem Code korrekt rausgesucht und in die entsprechenden Tabellenblätter eingefügt, jedoch habe ich ein Problem mit der Auswahl.
Beim ersten Durchlauf mit dem Schlüsselwort 402 findet er alle Einträge mit der 402 und fügt diese im entsprechenden Tabellenblatt ein.
Beim zweiten Durchlauf mit dem Schlüsselwort 416A lässt er die Einträge von der 402 markiert und fügt diese mit den Einträgen der 416A ins entsprechende Tabellenblatt ein.

Code:

Private Sub CommandButton1_Click()
    Dim x As Range, rng As Range, firstAddr As String
    Dim Arr$(3), i&
   
    Arr(0) = "402"
    Arr(1) = "416"
    Arr(2) = "416A"
    Arr(3) = "4171"
   
Sheets("Vorlage").Activate
ActiveSheet.UsedRange.Select
Selection.Sort Key1:=Range("I3"), _
Order1:=xlAscending, Header:=x2Guess, _
OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
   
For i = 0 To 3
        With Worksheets("Vorlage").UsedRange
        Set x = .Find(Arr(i), lookat:=xlWhole)
        If Not x Is Nothing Then
            firstAddr = x.Address
            Do
                If Not rng Is Nothing Then
                    Set x = Union(x, x.Offset(0, -3), x.Offset(0, -2), x.Offset(0, 3), x.Offset(0, 5), x.Offset(0, 6), x.Offset(0, 8), x.Offset(0, 9), x.Offset(0, 11), x.Offset(0, 12), x.Offset(0, 15))
                    Set rng = Union(rng, x)
                Else
                    Set rng = Union(x, x.Offset(0, -3), x.Offset(0, -2), x.Offset(0, 3), x.Offset(0, 5), x.Offset(0, 6), x.Offset(0, 8), x.Offset(0, 9), x.Offset(0, 11), x.Offset(0, 12), x.Offset(0, 15))
                End If
                Set x = .FindNext(x)
            Loop While Not x Is Nothing And x.Address <> firstAddr
        End If
    End With
    If Not rng Is Nothing Then rng.Copy
    Worksheets("PP_" & Arr(i)).Activate
    ActiveSheet.Range("A2").PasteSpecial xlValues
Next
End Sub

Wie kriege ich die Auswahl vor dem nächsten Durchlauf gelöscht, damit er die vorherigen Daten nicht auch mit kopiert?

Folgender Befehl hat leider nicht geholfen:

Code:

Application.CutCopyMode = False

Danke für eure Hilfe

Lg Primo

[Ralf A]

Hi,

setz rng vor dem Next wieder auf Nothing

[Primo Centurio]

Danke Danke Danke 
Ich bin fast verzweifelt und am Ende ist es so einfach.

Danke Ralf

Lg Primo

[snb]

Lösche jeden 'Select' und 'Activate'