Sayın feraz ilgili macroyu deneyip bilgi vereyim.

Tamam.Biliyorsununuz diye aktif hücre için şart koymadım yani if activecell.address(0,0)= "B2" then gibi yada intersect yöntemini felanda uygulayabilirsiniz.

Kriter bölümü baştan sonuna kadar kullanılabilir. Kodu denedim ama istediğim gibi bir sonuç vermedi.
İlk eklediğim dosyada arama yaparken içerir olarak düzeltebilsek çok iyi olacak. Şimdi ben B2:F2 aralığını kriter olarak yaptım bazen 1 hücreyi bazen de tamamına veri yazmak suretiyle arattırıyorum. Örneğin resmideki gibi. Resimde 1 isim arattırmışım ama * karakteri hem başına hem sonuna koydum. Kullanıcılar * işareti koymadan kullansın istiyorum.

Benim bildiğim gelişmiş olayı için kod kalıbı ayıdır.Resimde yaten istanbul geçenler bulunmuş.Allaki kodu deneyin birde.*a*a olarak aranmalı içerik olarak.

Sayın farez bey macroyu şu şekilde hallettim örnek dosyayı da buraya ekliyorum.

Sub Ara()
    Dim i As Byte
    For i = 2 To 6
        Cells(2, i).ClearContents
        If Cells(3, i) <> "" Then
            Cells(2, i) = "*" & Cells(3, i) & "*"
        End If
    Next i
    On Error Resume Next
    Range("B5").Select
    Selection.CurrentRegion.Select
    Selection.Clear
    Range("B5").Select
    Sheets("Veri").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("B1:F2"), CopyToRange:=Range("B5"), Unique:=False
    Range("F3").Select
End Sub

Cevaplanmış soruların içerisine taşıyabilirsiniz. Konuyu son örnekteki gibi çözüme kavuştu. Teşekkürler.