Macro To Import Data From Multiple Workbook Sheets In A Folder

[Jorrg1]

Hi

I want to be able to create a macro that can import sheet(s) from a excel file in a folder.

Detailed explanation:

Attached files:
- Macro
- ComapanyA

I want the macro to be made in the "Macro" file. I want to import the tabs "import this" from the CompanyA and CompanyB files. I want them to be imported to the CompanyA and CompanyB tabs in the "Macro" file. The macro should be linked to the "import" button in the " Macro" file.

Thank you very much

Kind Regards

Jørgen

Macro.xlsxCompanyA.xlsxCompanyB.xlsx

[Admin]

Hi

Try this

Option Explicit

Sub kTest()
    
    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
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            strFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    Set wbkActive = ThisWorkbook
    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

[Jorrg1]

Thank you very much

I couldnt get it to work though.. There must be something I do wrong. I just copied the code and pasted it in the macro section in the "macro" file.
All the three files (Macro, ComapanyA and CompanyB) are in the same folder, saved locally on my computer.

Got any more tips?

Again, thanks!

[Admin]

Hi

Copy the above code > open the Macro workbook > Hit Alt + F11 > goto Insert > Module and paste the code there on the white pane.

Change the copy range in the code where I made comments.

Now hit Alt+Q (to close the VBE window) then again hit Alt+F8 and run 'kTest' which will prompt for the source file folder, select the folder, rest the code will do.

[Jorrg1]

It works! Thank you very much

Is it possible to include to source file folder in the VBA code? To make it even more automatic?

Thanks!

[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

[Jorrg1]

Thank you again! It works perfect! I really appriciate it

I have one last question. I want to extend the formula a bit more. I want to use a filter function, after the sheets has been imported.

The process:

1) The VBA code imports all the company sheets to the "macro" file in the folder automatically.
2) The VBA code filters in the Macro file where all the sheets have been imported.

I have attached almost the same files and I have included one file that show how I want it to look after running the VBA code.

CompanyA.xlsxCompanyB.xlsxMacro - How I want it look after I run the macro.xlsmMacro.xlsm

Again, thanks!!

[Jorrg1]

Hi again

Which part of the macro decides which tab it is importing from? Does it only import from the first tab in each excel file? (companyA and companyB). If so, is it possible to link it to a certain tab? I want it to be linked to the "import this" tab.

thank you again