Macro Buscar, definir rango

Que tal Experto,
nececito que me heches la mano, mira hice esta macro, que funciona ..... Aqui viene el pero. La macro busca, encuentra, copia y pega la informacion en una hoja para tener un informe de lo que encontro, hasta aqui todo bien.
La Macro busca en todas las hojas del libro. Lo que pasa es que quiero decirle a la macro que busque solo a partir de la hoja 2 en delante. Por que por el momento me repite datos que acaba de encontrar y traer.
Te envio el codigo y un saludo, ojala me puedas ayudar, Gracias de antemano
Option Explicit
Public strSuch As String
Dim hojaDestino As Worksheet
Dim mySheet As String
Sub Suchen_alle_Tabellen_Datum()
On Error GoTo fin2
inicio:
Dim celdaOrigen As Variant
Set hojaDestino = Sheets(1)
Dim wks As Worksheet
Dim rng As Range
Dim strAddress As String, strFind As String
    If Range("A3") <> "" Then MsgBox "Zuerst bitte Daten löschen", vbCritical
    strFind = Application.InputBox(Prompt:="Datum eintragen bitte", Title:="Datum finden", Type:=1)
    If strFind = "" Then Exit Sub
    For Each wks In Worksheets
    Application.ScreenUpdating = False
        Set rng = wks.Cells.Find(What:=CDate(strFind), lookat:=xlPart, LookIn:=xlFormulas)
        If Not rng Is Nothing Then
        strAddress = rng.Address
        Do
            Application.Goto rng, True
            ActiveCell.Select
            celdaOrigen = ActiveCell.Address
            mySheet = ActiveSheet.name
            '************************************** Kopi
            Selection.EntireRow.Select
            Selection.Copy
            hojaDestino.Select
            Range("A2").Select
            Range("B65536").End(xlUp).Offset(1, -1).Select
            ActiveSheet.Paste
            Sheets(1).Cells.EntireColumn.AutoFit
            Application.CutCopyMode = False
            Range("F65536").End(xlUp).Offset(0, 0).Select
            ActiveCell.Offset(0, 1).Select
            ActiveCell.Value = mySheet + "!" + celdaOrigen
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=ActiveCell.Value, TextToDisplay:=ActiveCell.Value
            Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
            '********************* Kopi ende
            Set rng = Cells.FindNext(After:=ActiveCell)
            If rng.Address = strAddress Then Exit Do
        Loop
        End If
    Next wks
    strSuch = strFind
    Worksheets(1).Activate
    Call Format
    Range("A1").Select
    Sheets(1).Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    MsgBox "Bericht Fertig", False, Application.UserName
fin:
Exit Sub
fin2:
MsgBox ("Bitte es muss eine Datum sein")
Resume inicio
End Sub