Range("d2").ClearContents   'cancella il conteggio
Range("e2:e" & Rows.Count).ClearContents    'cancella i risultati
'cerca nella colonna A quello che c'è scritto in D1 considerando maiuscole e minuscole
Set fin = Columns(1).Find(What:=Range("d1"), LookAt:=xlPart, MatchCase:=True)
If Not fin Is Nothing Then
    firstaddress = fin.Address
    'ripete l'operazione cercando il risultato successivo
    Do
        cont = cont + 1 'conta
        Cells(cont + 1, 5) = fin    'riporta i risultati
        Set fin = Columns(1).FindNext(fin)  'cerca il risultato successivo
    Loop While Not fin Is Nothing And firstaddress <> fin.Address   'quando torna al primo risultato si ferma
End If
Range("d2") = cont  'scrive il conteggio

Option Explicit

Function count_of(r As Range, fnd As String) As Integer
'conta le occorrenze di "fnd" nel range "r"
'la function può essere usata anche nel fogli di lavoro come UDF
'come formula: =count_of(A1:A10;C2)
'come funzione: somma = count_of(Range("A1:A10"), "dG")
Dim re As Object, match As Variant
Dim text As String
    
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "#" & fnd
    re.IgnoreCase = False
    re.Global = True
    
    text = Join(Application.Transpose(r), "#")
    
    If re.Test(text) Then count_of = re.Execute(text).Count

End Function

Function conta_di(ByRef r As Range, fnd As String) As Long
    conta_di = Evaluate("SUMPRODUCT(--(EXACT(""" & fnd & """," & r.Address & ")))")
End Function