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
Son Düzenleme: 09/04/2020, 22:38, Düzenleyen: yyhy.