Failing to write a search and cut and paste macro

Hi top_dog,
try it

Sub ertert()
Dim s$, r
Application.ScreenUpdating = False
With Sheets("Data").Range("A1").CurrentRegion
    .Parent.AutoFilterMode = False: s = "~"
    For Each r In .Offset(1).Resize(.Rows.Count - 1).Columns(2).Value
        If InStr(s, "~" & r & "~") = 0 Then
            If Not Evaluate("ISREF('" & r & "'!A1)") Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = r
            Else
                Sheets(r).UsedRange.ClearContents
            End If
            .AutoFilter 2, r
            .Copy Sheets(r).Range("A1")
            s = s & r & "~"
        End If
    Next
    .AutoFilter
End With: Application.ScreenUpdating = True
End Sub

Man you did that so quick! Is there anyway to make it not make new tabs and use the ones I have already?

Many Thanks nilem, you have saved me so much headache.