Macro To Import Data From Multiple Workbook Sheets In A Folder

[Admin]

Hi

Here you go

Option Explicit

Sub kTest_v1()
    
    Dim wbkActive   As Workbook
    Dim wbkOpened   As Workbook
    Dim strFName    As String
    Dim strFolder   As String
    Dim strWkSht    As String
    
    Const ImportRange   As String = "B5:K22"    '<<<<< adjust this range
    
    Set wbkActive = ThisWorkbook
    
    strFolder = wbkActive.Path  'Macro workbook path
    'or
    'strFolder = "C:\My Folder"
    
    Application.ScreenUpdating = 0
    strFName = Dir(strFolder & "\*.xls*")
    
    Do While strFName <> vbNullString
        If strFName <> wbkActive.Name Then
            Set wbkOpened = Workbooks.Open(strFolder & "\" & strFName, 0)
            strWkSht = Left(strFName, InStrRev(strFName, ".") - 1)
            On Error Resume Next
            wbkOpened.Worksheets(1).Range(ImportRange).Copy wbkActive.Worksheets(strWkSht).Range("a1")
            If Err.Number <> 0 Then
                MsgBox "Worksheet '" & strWkSht & "' couldn't found!", vbCritical
            End If
            Err.Clear: On Error GoTo 0
            wbkOpened.Close 0
            Set wbkOpened = Nothing
        End If
        strFName = Dir()
    Loop
    Application.ScreenUpdating = 1
    
End Sub