Excel 2003 bestand dorsuchen und printen

Option Explicit
Option Compare Text

Const Bereich = "A1:A100"  
Const Zelle = "J50"  

'Werte von A1:A100 in die Sheets 1-100 Zelle J50 schreiben  
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Count <> 1 Or .Text = "" Or Application.Intersect(Range(Bereich), Target) Is Nothing Then Exit Sub  
    End With
    
    Sheets(CStr(Target.Row)).Range(Zelle).Value = Target.Value
End Sub

'Alle Sheets mit numerischen Namen, die den Suchbegriff in Zelle J50 enthalten ausdrucken  
Private Sub Button_Click()	
    Dim Wks As Worksheet, SheetArray As Variant, Suchtext As String, Count As Integer
    
    Suchtext = InputBox("Bitte Suchbegriff eingeben:", "Suchen und drucken...")  
    
    If Suchtext <> "" Then  
        For Each Wks In Sheets
            If IsNumeric(Wks.Name) Then
                If Wks.Range(Zelle).Value Like Suchtext Then
                    If IsArray(SheetArray) Then
                        Count = UBound(SheetArray) + 1
                        ReDim Preserve SheetArray(Count)
                        SheetArray(Count) = Wks.Name
                    Else
                        SheetArray = Array(Wks.Name)
                    End If
                End If
            End If
        Next
        If IsArray(SheetArray) Then Sheets(SheetArray).PrintOut Copies:=1
    End If
End Sub