Runtime Error when trying to Loop Worksheets

Question

Runtime Error 1004 was encountered, but the issue has not been resolved.

However, it doesn't loop to another sheet or function when I click run in a different sheet. It only functions when I click run on the XD1111X sheet. I would value any advice.

Answer 1

Copy To Multiple Worksheets

A Quick Fix

Option Explicit

Sub LoopWorksheetsAndRunVBA()
    
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Sheets(Array("XD1111X", "XD2222X", "XD3333X"))
        EachVeh ws
    Next ws

End Sub

Sub EachVeh(ByVal dws As Worksheet)

    Dim Response As Long: Response = MsgBox("Clear data?", vbYesNo, "CAUTION")
    If Response = vbNo Then Exit Sub
    
    Dim sws As Worksheet: Set sws = dws.Parent.Sheets("CALCULATE")
    Dim srg As Range
    Set srg = Intersect(sws.Range("A1:A5000"), sws.UsedRange)
    
    Dim dfCell As Range: Set dfCell = dws.Range("A2")
    Dim dName As String: dName = dws.Name
    dws.Range("A2:F1000").ClearContents

    Dim sCell As Range

    For Each sCell In srg.Cells
        If StrComp(CStr(sCell.Value), dName, vbTextCompare) = 0 Then
            sCell.Resize(, 7).Copy dfCell
            Set dfCell = dfCell.Offset(1)
        End If
    Next sCell

End Sub