Zeile in allen Tabellenblättern durchsuchen

Sub ButtonKalender()
t1 = ThisWorkbook.Worksheets("Menü").Range("C57")
If t1 = "Montag" Or t1 = "Dienstag" Or t1 = "Mittwoch" Or t1 = "Donnerstag" Or t1 = "Freitag"   _
_
Then
w1 = ThisWorkbook.Worksheets("Menü").Range("C58")
Dim rngSuche1 As Range
For Each Sheet In ActiveWorkbook.Sheets
For Each rngSuche1 In Worksheets.Range("B9 : BZ9").Find(What:=w1, LookAt:=xlWhole) ' _
kann die row nicht bestimmen, deswegen die range
If Not rngSuche1 Is Nothing Then rngSuche1.EntireColumn.Select
Selection.EntireColumn.Copy
Selection.Insert Shift:=xlToRight
Set rngSuche1 = ActiveSheet.Range("B9 : BZ9").Find(What: _
_
=w1, LookAt:=xlWhole)
If Not rngSuche1 Is Nothing Then rngSuche1.Select
ActiveCell.Value = w1 & " a"
Set rngSuche1 = ActiveSheet.Range("B9 : BZ9").Find(What: _
_
=w1, LookAt:=xlWhole)
If Not rngSuche1 Is Nothing Then rngSuche1.Select
ActiveCell.Value = w1 & " b"
ThisWorkbook.Worksheets("Menü").Select
Next rngSuche1
Next Sheet
Else
End If
End Sub

Bin dankbar für jede Hilfe!!!