Page 1 of 3 123 LastLast
Results 1 to 10 of 30

Thread: VBA to copy data from multiple workbooks into a Master wkbk

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    24
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default VBA to copy data from multiple workbooks into a Master wkbk

    I have to copy data from different workbooks and paste it into a master workbook. All the workbooks are located in a folder: C:\Users\f65651\data transfer.

    Data is copied from the first sheet from the workbooks. I have to open each workbook, go to the first sheet (first sheet only contains the data) select columns range A to GJ starting from row 5 to the end of the table, then copy and paste the data into master worksheet. In the master worksheet, I paste the data from columns A to GJ row 5 and continue pasting/appending the data as I copy data from more workbooks. However, the Master wkbk contains more (additional) columns (scattered between col A to W, the rest of the cols have the same format) which are not present in the source wkbks. This is exactly what makes my work tedious; having to copy the data carefully from each workbook into the master sheet and taking note of leaving the extra columns of the Master blank

    I found a similar thread to this here:
    https://www.mrexcel.com/forum/excel-...ter-sheet.html but the solution in that thread works for only sheets of the same formats.

    So what I want is: a VBA code that copies data from several workbooks into the Master wkbk while neglecting the extra columns (in the Master) blank. The copied data should only be from the tables of the source workbooks and not copy graphs or charts that might be present after the tables. I'm not good with VBA as I just started learning so I will appreciate any help anyone can provide.

    If you also need more clarification, let me know

  2. #2
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,301
    Post Thanks / Like
    Mentioned
    95 Post(s)
    Tagged
    5 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Make sure that your Master workbook contains a sheet named "Master". Copy/paste the macro below into a standard Module in the Master workbook. Save the workbook as a macro-enabled file.
    Code:
    Sub CopyCols()
        Application.ScreenUpdating = False
        Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook
        Set desWS = ThisWorkbook.Sheets("Master")
        Dim LastRow As Long, i As Long, header As Range, x As Long
        Const strPath As String = "C:\Users\f65651\data transfer\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Set srcWS = Sheets(1)
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With srcWS.Range("A:GJ")
                For i = 1 To .Areas.Count
                    x = .Areas(i).Column
                    Set header = desWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(5, x), srcWS.Cells(LastRow, x)).Copy desWS.Cells(desWS.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                    End If
                Next i
            End With
            srcWB.Close False
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Without access to your Master workbook and a copy of at least one of your source workbooks, I couldn't test the macro. If the macro doesn't work for you, perhaps you could upload a copy of your Master file and a copy of at least one destination file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  3. #3
    New Member
    Join Date
    Aug 2019
    Posts
    24
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Quote Originally Posted by mumps View Post
    Make sure that your Master workbook contains a sheet named "Master". Copy/paste the macro below into a standard Module in the Master workbook. Save the workbook as a macro-enabled file.
    Code:
    Sub CopyCols()
        Application.ScreenUpdating = False
        Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook
        Set desWS = ThisWorkbook.Sheets("Master")
        Dim LastRow As Long, i As Long, header As Range, x As Long
        Const strPath As String = "C:\Users\f65651\data transfer\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Set srcWS = Sheets(1)
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With srcWS.Range("A:GJ")
                For i = 1 To .Areas.Count
                    x = .Areas(i).Column
                    Set header = desWS.Rows(1).Find(.Areas(i).Cells(1), LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(5, x), srcWS.Cells(LastRow, x)).Copy desWS.Cells(desWS.Rows.Count, header.Column).End(xlUp).Offset(1, 0)
                    End If
                Next i
            End With
            srcWB.Close False
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Without access to your Master workbook and a copy of at least one of your source workbooks, I couldn't test the macro. If the macro doesn't work for you, perhaps you could upload a copy of your Master file and a copy of at least one destination file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark each file for 'Sharing' and you will be given a link to each file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells, rows, columns and worksheets. If the workbook contains confidential information, you could replace it with generic data.
    Thanks mumbps, I tried it but the files doesnt copy. I have created dummy data to help with your test because the data is confidential. Here is the link to the file:
    Data 1: https://www.dropbox.com/s/r8kzvmlli9...ata1.xlsx?dl=0
    Data 2: https://www.dropbox.com/s/pk5pppgp5h...ata2.xlsx?dl=0
    and the Master file: https://www.dropbox.com/s/l278m5yb3m...ults.xlsx?dl=0

    As you will see, the Master file contains more columns than the source workbooks, I want the code to ignore these columns that were not present in the source and copy the data for the columns that directly corresponds to the column titles. For example, Columns "Targetable", "Finance Responsible", "Technical" should remain blanks after the data transfer

  4. #4
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,301
    Post Thanks / Like
    Mentioned
    95 Post(s)
    Tagged
    5 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Rename the sheet in the "results" workbook to "Master" and try this macro:
    Code:
    Sub CopyCols()
        Application.ScreenUpdating = False
        Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook, rng As Range, LastRow As Long, header As Range
        Set desWS = ThisWorkbook.Sheets("Master")
        Const strPath As String = "C:\Users\f65651\data transfer\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Set srcWS = Sheets(1)
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS
                For Each rng In .Range("A3:L3")
                    Set header = srcWS.Rows(3).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(4, header.Column), srcWS.Cells(LastRow, header.Column)).Copy .Cells(.Rows.Count, rng.Column).End(xlUp).Offset(1, 0)
                    End If
                Next rng
                srcWS.Range("H4:U" & LastRow).Copy desWS.Cells(desWS.Rows.Count, 13).End(xlUp).Offset(1, 0)
                desWS.Columns.AutoFit
            End With
            srcWB.Close False
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  5. #5
    New Member
    Join Date
    Aug 2019
    Posts
    24
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Quote Originally Posted by mumps View Post
    Rename the sheet in the "results" workbook to "Master" and try this macro:
    Code:
    Sub CopyCols()
        Application.ScreenUpdating = False
        Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook, rng As Range, LastRow As Long, header As Range
        Set desWS = ThisWorkbook.Sheets("Master")
        Const strPath As String = "C:\Users\f65651\data transfer\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Set srcWS = Sheets(1)
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS
                For Each rng In .Range("A3:L3")
                    Set header = srcWS.Rows(3).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(4, header.Column), srcWS.Cells(LastRow, header.Column)).Copy .Cells(.Rows.Count, rng.Column).End(xlUp).Offset(1, 0)
                    End If
                Next rng
                srcWS.Range("H4:U" & LastRow).Copy desWS.Cells(desWS.Rows.Count, 13).End(xlUp).Offset(1, 0)
                desWS.Columns.AutoFit
            End With
            srcWB.Close False
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Hi @mumps, thanks for you help!. I tried this and it works. However, when I try to use this same format to implement on my real workbooks, some of the cells returned as empty (edited the code to reflect my real workbooks).

    I have created some dummy workbks again but this time containing the real headers and the absent columns. I have added the link below, please help take a look at whats wrong and let me know if you need anything.
    Master file: https://www.dropbox.com/s/ogxnsol30i...ster.xlsm?dl=0
    Data1 : https://www.dropbox.com/s/6vtz2ncqhs...ata3.xlsx?dl=0
    Data2: https://www.dropbox.com/s/1oi69010zk...ata4.xlsx?dl=0

  6. #6
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,301
    Post Thanks / Like
    Mentioned
    95 Post(s)
    Tagged
    5 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Try:
    Code:
    Sub CopyCols()
        Application.ScreenUpdating = False
        Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook, rng As Range, LastRow As Long, header As Range, NH As Long
        Set desWS = ThisWorkbook.Sheets("Master")
        Const strPath As String = "C:\Users\G852589\data transfer\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Set srcWS = Sheets(1)
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS
                For Each rng In .Range("A4:X4")
                    Set header = srcWS.Rows(3).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(4, header.Column), srcWS.Cells(LastRow, header.Column)).Copy .Cells(.Rows.Count, rng.Column).End(xlUp).Offset(1, 0)
                    End If
                Next rng
                NH = .Rows(4).Find("NH").Column
                srcWS.Range("M4:Z" & LastRow).Copy desWS.Cells(desWS.Rows.Count, NH).End(xlUp).Offset(1, 0)
                desWS.Columns.AutoFit
            End With
            srcWB.Close False
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  7. #7
    New Member
    Join Date
    Aug 2019
    Posts
    24
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Quote Originally Posted by mumps View Post
    Try:
    Code:
    Sub CopyCols()
        Application.ScreenUpdating = False
        Dim desWS As Worksheet, srcWS As Worksheet, srcWB As Workbook, rng As Range, LastRow As Long, header As Range, NH As Long
        Set desWS = ThisWorkbook.Sheets("Master")
        Const strPath As String = "C:\Users\G852589\data transfer\"
        ChDir strPath
        strExtension = Dir(strPath & "*.xlsx")
        Do While strExtension <> ""
            Set srcWB = Workbooks.Open(strPath & strExtension)
            Set srcWS = Sheets(1)
            LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            With desWS
                For Each rng In .Range("A4:X4")
                    Set header = srcWS.Rows(3).Find(rng, LookIn:=xlValues, lookat:=xlWhole)
                    If Not header Is Nothing Then
                        srcWS.Range(srcWS.Cells(4, header.Column), srcWS.Cells(LastRow, header.Column)).Copy .Cells(.Rows.Count, rng.Column).End(xlUp).Offset(1, 0)
                    End If
                Next rng
                NH = .Rows(4).Find("NH").Column
                srcWS.Range("M4:Z" & LastRow).Copy desWS.Cells(desWS.Rows.Count, NH).End(xlUp).Offset(1, 0)
                desWS.Columns.AutoFit
            End With
            srcWB.Close False
            strExtension = Dir
        Loop
        Application.ScreenUpdating = True
    End Sub
    Several columns still came back blank

  8. #8
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,301
    Post Thanks / Like
    Mentioned
    95 Post(s)
    Tagged
    5 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    It seem to be working properly for me with the files you posted. Which columns in the Master still come out blank?
    When responding, please click the "Reply" button instead of the "Reply with Quote" button. It keeps responses less cluttered.
    Last edited by mumps; Oct 22nd, 2019 at 09:07 AM.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  9. #9
    New Member
    Join Date
    Aug 2019
    Posts
    24
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    The content was copied completely using the sheets I shared. However, when I transferred the code to the original file, the contents were copied up to col R (Org function Owner) The rest of the columns were blank

  10. #10
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,301
    Post Thanks / Like
    Mentioned
    95 Post(s)
    Tagged
    5 Thread(s)

    Default Re: VBA to copy data from multiple workbooks into a Master wkbk

    Click here to download a copy of the Master file. It shows the result that I got with the files you posted. Does it look correct to you? If not, please explain in detail how it is not working for you.
    Practice makes perfect. I'm very far from perfect so I'm still practising.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •