Errors if sheet doesn't exist...

[amazingkarma67]

I have code that requests the user to enter a sheet name (5 letter customer code) opens any excel file in the designated folder, in this case four files, and if the sheet exists, copies it to the current workbook. The problem I run into is that if the sheet doesn't exist for that customer, it errors out. The problem is that not all customers will have a sheet in all four files.

The files will always have the same names, but I want to leave the option open to add or remove files so I've kept the code generic in that respect. I've got almost zero experience with error handling, so any help would be greatly appreciated.

Sub CombineSheetsTest()

    Dim SFname As String
    Dim wbk As Workbook
    Dim ws As Worksheet
    Dim wSht As Variant
    Const sPath As String = "S:xxx[real path inserted here]xxx\"
        
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ChDir sPath
    SFname = Dir(sPath & "\" & "*" & ".xls", vbNormal)
    wSht = InputBox("Enter Required Customer Code")
    Do Until SFname = ""
        Set wbk = Workbooks.Open(sPath & SFname)
        Windows(SFname).Activate
        Sheets(wSht).Copy After:=ThisWorkbook.Sheets(1)
        wbk.Close False
        SFname = Dir()
    Loop
    
    Sheets(1).Delete
    Sheets(3).Move After:=Worksheets(Worksheets.Count)
    Sheets(2).Move After:=Worksheets(Worksheets.Count)
    Sheets(1).Move After:=Worksheets(Worksheets.Count)
    Sheets(4).Name = "Inventory"
    Sheets(3).Name = "Shortages"
    Sheets(2).Name = "CTB"
    Sheets(1).Name = "Commit Summary"
    Sheets(1).Select
    Application.Dialogs(xlDialogSaveAs).Show Format(Date, "mmddyy") & " " & wSht & " Report Package.xls"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
        
    
End Sub

 

[jmthompson]

Try this (untested)

Do Until SFname = ""         
Set wbk = Workbooks.Open(sPath & SFname)         
Windows(SFname).Activate
        For each ws in wbk.Sheets
              If ws.Name = wSht Then
              Sheets(wSht).Copy After:=ThisWorkbook.Sheets(1)
              End If
        Next ws
        wbk.Close         
SFname = Dir()     
Loop

 

[amazingkarma67]

Jen,

You're an angel, it worked perfectly! Now it breaks at my attempted sheet renaming on the bottom because there aren't always four sheets. I can probably muddle my way through that though.

Thanks a million!

Ron