Merge data from multiple workbooks into one sheet

[RvEPE]

Hello all,

I am looking for a solution for the following problem: I want to automatically merge data from several action lists into one big action list.

In "C:\directory 1" the file is located where I want to combined all the data, this file is called "Merged data.xlsm", this workbook has a sheet called "Sheet 1". The data should be copied to the cells B2:I???, and the data from the next action list should be pasted beneath this data.

The separate actions lists are located in multiple subdirectories with different names in "C:\directory 1", and all those files also have different names. All these workbooks are .xlsm files and they all have a worksheet called "Action List". The data in these sheets is located in B17:I???.

I want to make a macro in the workbook "Merged data.xlsm" that automatically merges the actions into one big action list.

I hope you guys and gals can help me.

Kind regards,
RvEPE

 

[RvEPE]

Hello all,

Still hoping someone can help me with this issue.
Im not a VBA hero.

Kind regards,
RvEPE

 

[mumps]

When you say:

The separate actions lists are located in multiple subdirectories with different names in "C:\directory 1"

Are the workbooks that contain the sheet "Action List" the only workbooks in each sub directory or are there other workbooks in those sub directories as well?

 

[RvEPE]

Hello mumps,

Those are the only workbooks files in the subdirectories.
Some more information, all the workbooks in the subdirectories start with the same name but then have additions at the end of the filename.

5S+1 Zone 1.xlsm
5S+1 Zone 2.xlsm
etc...

Thanks already!!

Kind regards,
RvEPE

 

[mumps]

Place these macros in a regular module in the "Merged data.xlsm" workbook. Have a look at the two comments I placed in the code and make any necessary changes. Run the LoopThroughSubFolders macro.

Sub LoopThroughSubFolders()
    Application.ScreenUpdating = False
    CopyRange ("C:\directory 1") 'Check to make sure the the main folder path is correct.
    Application.ScreenUpdating = True
End Sub

Sub CopyRange(ByVal MyPath As String)
    Dim FileSys As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Dim wb As Workbook
    Dim desSH As Worksheet
    Set desSH = ThisWorkbook.Sheets("Sheet 1") 'Check to make sure that the sheet name is correct. There is a space to the left of the 1.
    Set FileSys = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FileSys.GetFolder(MyPath)
    For Each objSubFolder In objFolder.SubFolders
        For Each objFile In objSubFolder.Files
            If InStr(objFile.Name, ".xlsm") Then
                Set wb = Workbooks.Open(filename:=objFile)
                LastRow = Sheets("Action List").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                Sheets("Action List").Range("B17:I" & LastRow).Copy desSH.Cells(desSH.Rows.Count, "B").End(xlUp).Offset(1, 0)
                wb.Close False
            End If
        Next
        Call CopyRange(objSubFolder.Path)
    Next
End Sub

 

[Muhammad Hussaan]

I want to copy data from one sheet name "summary" to multiple sheets name 1,2,3 upto 30.
For example in summary sheet column 1 i have sheet names and daily sale in column 2
Column 1 Column 2
Sheet name daily sale
1 100
2 200
3 300
4 400

From summary sheet i want to move/copy data to the respective name sheets cell A5. Like 100 to sheet 1 in cell A5, 200 to sheet 2 in cell A5 and so on..
Kindly help me for this. Thank you in anticipation.

 

[mumps]

@Muhammad Hussaan: Welcome to the Forum. Please note that Forum rules state that you should not post your question in someone else's thread. Please start a new thread of your own. If you send me a private message with a link to your new thread, I can certainly have a look at it.

 

[Muhammad Hussaan]

@mumps sorry i am new to Mr. Excel and mistakenly post here

 

[mumps]

Not a problem. Please take a minute to read the Forum Rules at this link: https://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html

 

[RvEPE]

Hello all,

Sorry for the late reply.
Thank you very much, the solution worked perfectly.

Kind regards,
RvEPE