Sub Kontrolle()
Dim bereich As Range 'Variable für den Quellbereich
Dim i As Long 'Zähler für die Anzahl des gesuchten Wertes
Dim zelle As Range 'Zelle die im Bereich verglichen wird
Dim frage As Variant 'Variable für das Ergebnis der Eingabebox
On Error Resume Next 'nötig um bei Fehler nicht zu hängen
Set bereich = Sheets(1).Range("A1:A9")
'Hier musst Du den Bereich anpassen, bei mir als Test A1:A9
i = 0 'Sicherstellen, dass i am Anfang null ist
frage = InputBox("Was willst Du zählen", vbOKCancel)
'Hier kannst Du den Benutzer fragen, was er im Quellbereich zählen will
If frage = "" Then 'bei leerem Feld oder Abbrechen
Exit Sub 'verlasen der Sub
Else 'sonst abklappern des Bereichs und bei jedem gefundenen Wert
'hochzählen der Variablen i
For Each zelle In bereich
Select Case zelle.Value
Case Is = frage
i = i + 1
Case Else
End Select
Next ' Schlaufe, bis alle Zellen im Bereich abgefragt sind
End If 'Ende der Bedingung von oben
Sheets(2).Range("B17").Value = i 'Eintrag des Zählers i in die Zelle
End Sub
versuch es mal, bin leider nachher abwesend
Gruss