Suchfunktion in VBA

Option Explicit
Private Sub CommandButton1_Click()
Const z1 = 4 'erste Suchzeile
Dim shK As Worksheet
Dim z As Long, z0 As Long, I As Long, lz As Long
Dim blatt As Integer
' Spalte A = Nummer, Spalte B = Datum, Spalte C = Buchungstext, Spalte D = Kostenarten, Spalte E = Ausgaben, Spalte F = Einnahme
Dim Nummer As String, Datum As Date, Buchungstext As String, Kostenarten As String, Ausgaben As Double, Einnahmen As Double
z0 = 7 'erste Ausgabezeile in "Suche"
Me.Rows(z0 & ":" & Rows.Count).ClearContents
Columns("G:H").Hidden = True
'ab Blatt 2 bis zum letzten (1 ist wohl das Suchblatt)
For blatt = 2 To ThisWorkbook.Sheets.Count
Set shK = Sheets(blatt)
With shK
z = z1
lz = .Cells(Rows.Count, 1).End(xlUp).Row
Do
'Datensatz ermitteln:
On Error Resume Next
Datum = CDate(.Cells(z, 2))
If Err.Number > 0 Then
MsgBox "Fehler in Blatt " & .Name & ", Zeile" & z
Exit Sub
End If
On Error GoTo 0
Ausgaben = .Cells(z, 8)
Einnahmen = .Cells(z, 9)
Buchungstext = ""
Do
Buchungstext = Buchungstext & " " & .Cells(z, 3)
z = z + 1
Loop Until .Cells(z, 1)  "" Or z > lz
Buchungstext = Mid(Buchungstext, 3)
'Filter:
If InStr(UCase(Buchungstext), UCase(Range("Suchtext"))) > 0 Then
Cells(z0, 1) = Nummer
Cells(z0, 2) = Datum
Cells(z0, 3) = Buchungstext
Cells(z0, 4) = Kostenarten
Cells(z0, 5) = Ausgaben
Cells(z0, 6) = Einnahmen
Cells(z0, 1) = z - 4
z0 = z0 + 1
End If
Loop Until z > lz
End With
Next blatt
End Sub