filtrare celle

Option Explicit

Sub ApplicaFiltro1()
Dim c As String
Dim y As Range

'ActiveSheet.Unprotect "123456"

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

c = Range("A2")
c = c & "*"  '<<< trova all'inizio della parola
c = "*" & c & "*" '<<< trova in mezzo alle parole

Set y = Range("F2:F3500") '<<<<<<<<<<<<
If Range("A2") = "" Then

MsgBox "Inserire il testo da cercare"

Range("A2").Select

End If
If Application.WorksheetFunction.CountIf(y, c) = 0 Then

MsgBox "Nessun elemento trovato"

Range("A2") = Null
Range("A2").Select

Else
ActiveSheet.Range("$F$1:$F$3500").AutoFilter Field:=1, Criteria1:=c '<<< filtro
End If

Application.Calculation = xlAutomatic

'Range("A1").Value = "ARTICOLI TROVATI: " & Application.WorksheetFunction.CountIf(y, c)
MsgBox "ARTICOLI TROVATI: " & Application.WorksheetFunction.CountIf(y, c)

Application.ScreenUpdating = True

'ActiveSheet.Protect "123456"

End Sub