Help with modifying code to look for like sheetnames

[menor59]

Hello all,

So i have this working...This is a module that when i click on a sheet this runs on that sheet and takes the data it finds and places it on theDataQuote Sheet.

what i need to do is this...If any worksheet in the workbook starts with ohhh i dont know...Say Daughter. then run the code on those sheets and work like it is now...

Sub QuoteCopy()
Application.Run "UnprotectDataQuote"
Application.ScreenUpdating = False
    ActiveWorkbook.Sheets("DataQuote").Activate
    Range("A2:H1062").Select
    Selection.Delete Shift:=xlUp
    
    Call Select_Last
    
    Application.Goto "startCell"
    Dim i As Range
    For Each i In Range("D7:D62")
        If i.Value > 0 Then
            i.Select
       ActiveCell.Offset(0, -3).Resize(1, 6).Copy
        Sheets("DataQuote").Range("C2").Insert Shift:=xlDown
        End If
    Next i
    ActiveWorkbook.Sheets("DataQuote").Activate
    Columns("G:H").Select
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Range("A1").Select
    
    Call Select_Last
    
    Application.Goto "startCell"
    Application.Run "ProtectAll"
End Sub

thoughts?

[menor59]

I tried this with the above code but somethings wrong...

Sub ScanWs()
Dim WS As Worksheet

    For Each WS In ThisWorkbook.Sheets
        If InStr(1, WS.Name, "Daughter", vbTextCompare) > 0 Then
        ws.activate
        QuoteCopy
        End If
    Next WS
    
End Sub

When i run this...its like its overwriting the last entry...i think it needs a little help..