runtime Error 9 when opening excel workbook in a folder to copy specific sheet

Copy Worksheet Ranges From Multiple Workbooks to a New Workbook

The Workbooks

1. The workbook containing this code (ThisWorkbook).
2. The source workbook i.e. each workbook (file) found in the source folder.
3. The destination workbook i.e. a newly added workbook that will be copied to.

Description

• This will copy the first row of a same-named worksheet of each workbook (file) found in a folder to a newly added (and renamed) worksheet (multiple) of a new workbook (one).

Option Explicit

Sub CreateMaster()
    Const ProcName As String = "CreateMaster"
    On Error GoTo ClearError
    
    ' Source
    Const sFolderPath As String = "D:\My Document\" ' maybe a missing 's'?
    Const sFilePattern As String = "*"
    Const sExtensionPattern As String = ".xls*"
    Const swsName As String = "Master User"
    ' Destination
    Const dFileName As String = "Master.xlsx"
    ' You never mentioned the destination path ('Master.xlsx') so I chose
    ' the same path as the path of the workbook containing this code.
    ' Omitting this path will lead to unexpected results (errors).
    Dim dFilePath As String: dFilePath = ThisWorkbook.Path & "\"
    Dim dFileFormat As XlFileFormat: dFileFormat = xlOpenXMLWorkbook
    
    ' Check if the source folder exists.
    If Len(Dir(sFolderPath, vbDirectory)) = 0 Then
        MsgBox "The folder '" & sFolderPath & "' doesn't exist.", _
            vbCritical, ProcName
        Exit Sub
    End If
    
    ' Return the paths of the files of the source folder in a collection.
    Dim sFilePaths As Collection
    Set sFilePaths = CollFilePaths(sFolderPath, sFilePattern, sExtensionPattern)
    If sFilePaths Is Nothing Then ' no files found
        MsgBox "No '" & sExtensionPattern & "'- files found in folder '" _
            & sFolderPath & "'.", vbCritical, ProcName
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim sFilePath As Variant
    
    Dim dwb As Workbook
    Dim dws As Worksheet
    Dim dwbCreated As Boolean
    
    ' Loop through the elements (file paths) of the collection.
    For Each sFilePath In sFilePaths
        Set swb = Workbooks.Open(sFilePath)
        ' Attempt to create a reference to the source worksheet.
        On Error Resume Next
            Set sws = swb.Worksheets(swsName)
        On Error GoTo ClearError
        If Not sws Is Nothing Then ' source worksheet exists
            ' Add a new worksheet/workbook.
            If dwbCreated Then ' destination workbook created
                Set dws = dwb.Worksheets _
                    .Add(After:=dwb.Sheets(dwb.Sheets.Count))
            Else ' destination workbook not created
                Set dwb = Workbooks.Add(xlWBATWorksheet) ' one worksheet
                Set dws = dwb.Worksheets(1)
                dwbCreated = True
            End If
            ' Attempt to rename the destination worksheet.
            On Error Resume Next
                dws.Name = Left(swb.Name, InStrRev(swb.Name, ".") - 1)
            On Error GoTo ClearError
            ' Copy source to destination.
            sws.Rows(1).Copy dws.Rows(1)
            Set sws = Nothing 
        'Else ' source worksheet doesn't exist
        End If
        swb.Close SaveChanges:=False
    Next sFilePath
    
    If dwbCreated Then
        dwb.Worksheets(1).Activate
        Application.DisplayAlerts = False ' overwrite without confirmation
        dwb.SaveAs dFilePath & dFileName, dFileFormat
        Application.DisplayAlerts = True
        dwb.Close
        MsgBox "Master created.", vbInformation, ProcName
    Else
        MsgBox "Non of the opened workbooks contained a worksheet " _
            & "named '" & swsName & "'.", vbExclamation, ProcName
    End If
    
    Application.ScreenUpdating = False
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the paths of the files of a folder in a collection.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CollFilePaths( _
    ByVal FolderPath As String, _
    Optional ByVal FilePattern As String = "*", _
    Optional ByVal ExtensionPattern As String = "*") _
As Collection
    Const ProcName As String = "CollFilePaths"
    On Error GoTo ClearError
    
    Dim pSep As String: pSep = Application.PathSeparator
    Dim foPath As String: foPath = FolderPath
    If Right(foPath, 1) <> pSep Then foPath = foPath & pSep
    
    Dim ePattern As String: ePattern = ExtensionPattern
    If Left(ePattern, 1) <> "." Then ePattern = "." & ePattern
    
    Dim fiName As String: fiName = Dir(foPath & FilePattern & ePattern)
    If Len(fiName) = 0 Then Exit Function
        
    Dim coll As Collection: Set coll = New Collection
    
    Do Until Len(fiName) = 0
        coll.Add foPath & fiName
        fiName = Dir
    Loop
    
    Set CollFilePaths = coll
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function