VBA Excel copy data between workbooks in the same directory when the worksheet doesn't appear in all files

Question

I want to pick up the data from the files, in which the particular worksheet exists. I have over 10 files; some don't contain the worksheet I am after. I've decided to skip them.

My code looks like this:

Sub CopyDataBetweenWorkbooks_Civils()

Dim wbSource As Workbook
Dim shTarget As Worksheet
Dim shSource As Worksheet
Dim strFilePath As String
Dim strPath As String
Dim i As Long


' Initialize some variables and
' get the folder path that has the files
Set shTarget = ThisWorkbook.Sheets("Civils Work Order")
strPath = GetPath

' Make sure a folder was picked.
If Not strPath = vbNullString Then

    ' Get all the files from the folder
    strfile = Dir$(strPath & "*.xls", vbNormal)

    
            Do While Not strfile = vbNullString
                ' Open the file and get the source sheet
                Set wbSource = Workbooks.Open(strPath & strfile)
                For i = 1 To Worksheets.Count
                If Worksheets(i).Name = "Civils Work Order" Then
                Set shSource = wbSource.Sheets("Civils Work Order")
                End If
                Next i
                
                'Copy the data
                Call CopyData_Civils(shSource, shTarget)

                'Close the workbook and move to the next file.
                wbSource.Close False
                strfile = Dir$()
            Loop
        
End If

End Sub

' Procedure to copy the data.
Sub CopyData_Civils(ByRef shSource As Worksheet, shTarget As Worksheet)

If shSource Is Nothing Then
On Error GoTo 0
Else
Const VHead As String = "A1:H1"
Const VMBom As String = "A2:H100"

shSource.Range(VHead).Copy

With shTarget.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
End If


Dim lRow As Long
Dim i As Integer



lRow = shTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1

If shSource Is Nothing Then
On Error GoTo 0
Else
shSource.Range(VMBom).Copy

With shTarget.Range("A" & lRow)
.PasteSpecial xlPasteValuesAndNumberFormats
.PasteSpecial xlPasteFormats
'.RemoveDuplicates Columns:=1, Header:=xlYes
.Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlYes
.WrapText = True
End With

shTarget.Columns("A").ColumnWidth = 6.11
shTarget.Columns("B").ColumnWidth = 50
shTarget.Columns("C").ColumnWidth = 50
shTarget.Columns("D").ColumnWidth = 5.44
shTarget.Columns("E").ColumnWidth = 5.89
shTarget.Columns("F").ColumnWidth = 9
shTarget.Columns("G").ColumnWidth = 21.22
shTarget.Columns("H").ColumnWidth = 10.89
shTarget.Rows.EntireRow.AutoFit


For i = 3 To lRow Step 4
shTarget.Range(shTarget.Cells(i, 1), shTarget.Cells(i, 5)).Interior.Color = RGB(235, 235, 235)
shTarget.Range(shTarget.Cells(i, 7), shTarget.Cells(i, 8)).Interior.Color = RGB(235, 235, 235)
Next i



' Reset the clipboard.
Application.CutCopyMode = xlCopy


Call code_clearance_civils

End If
   

End Sub

Unfortunately, after the execution of several sheets, I receive an error:

Method 'Range of object'_Worksheet failed to point out the following line:

  shSource.Range(VHead).Copy

How could I skip the workbooks, which don't have this worksheet and proceed as normal?

UPDATE:

When using WorksheetExists function, the error appears here:

Why did you not try my suggestion of `WorksheetExists` to your previous question? — BigBen, Feb 14 '23 at 16:09
I tried but had an error at the line of Set sht = wb.Sheets("Civil Works Order") that it's out of range — Geographos, Feb 14 '23 at 16:15
It might be helpful to [edit] your question with that specific attempt? Likely you're overlooking something simple. — BigBen, Feb 14 '23 at 16:16
I think I am quite close with the current approach, but don't understand why it throws me exactly at the same file over and over again. — Geographos, Feb 14 '23 at 16:19
Your recent update would suggest that you have selected `Tools->Options->General->Error Trapping->Break on All Errors`. Select `...Break on Unhandled Errors` instead. — VBasic2008, Feb 14 '23 at 17:20

VBasic2008 · Accepted Answer · 2023-02-14T17:05:31.947

1

Skip Workbooks Not Containing a Worksheet

A Quick Fix

            Exit For ' it was found; no need to loop any more
        End If
    Next i
            
    If Not shSource Is Nothing Then ' worksheet exists
        'Copy the data
        Call CopyData_Civils(shSource, shTarget)
        Set shSource = Nothing ' reset for the next iteration
    'Else ' worksheet doesn't exist; do nothing
    End If

An Improvement

Do While Len(strfile) > 0
    Set wbSource = Workbooks.Open(strPath & strfile)
    On Error Resume Next ' prevent error when worksheet doesn't exist
        Set shSource = wbSource.Sheets("Civils Work Order")
    On Error GoTo 0
    If Not shSource Is Nothing Then ' worksheet exists
        CopyData_Civils shSource, shTarget
        Set shSource = Nothing ' reset for the next iteration
    'Else ' worksheet doesn't exist; do nothing
    End If
    wbSource.Close False
    strfile = Dir
Loop

edited Feb 14 '23 at 17:05

answered Feb 14 '23 at 16:48

VBasic2008

44,888
5
17
28

At the following line: Set shSource = wbSource.Sheets("Civils Work Order") the error appears: Subscript out of range – Geographos Feb 14 '23 at 17:20
1

Select `Tools->Options->General->Error Trapping->Break on Unhandled Errors`. – VBasic2008 Feb 14 '23 at 17:22
Could you just tell me where this Exit For should come from? In the first solution? Below which line? – Geographos Feb 14 '23 at 17:24
Right above `End If` (below `Set...`). The code will work without it, it will just loop longer. – VBasic2008 Feb 14 '23 at 17:25

VBA Excel copy data between workbooks in the same directory when the worksheet doesn't appear in all files

1 Answers1

Skip Workbooks Not Containing a Worksheet