Copy and Paste data from multiple workbooks into one workbook

abhay_547

Board Regular
Joined
Sep 12, 2009
Messages
179
I have requirement to copy a range of data from multiple workbooks into one workbook, but the ask is not to save the macro in either of the workbooks. So i need a third file which would have the names of the files listed in Cell A4 to A12 (can be more files as well). Cell A2 would consist the date when I select the date the names of the workbooks which are listed in cell A4 to A12 will get updated since they all would have date in their names, once the names are updated I would run the macro which would first open the main template workbook, the name of which would be in Cell B2 and it's path is in C1 and then open each file in loop from cell A4 to A12 and copy the data from the range which is mentioned in the cell C4 to C12 from each source file and paste it into the template file range mentioned in column D4 to D12, for each file the path would be different so the path will be mentioned in Column B .i.e. B4 to B12. Incase the current date file is not available on the path then column E4 to E12 would get populated with text "File not available", if available and the data is copied then "File Available. Data Copied"


Below is the sample structure of the file.


Select Date:
Main Template File Name:
Template File Path:
11/21/2017
template.xlsx
c:\users\template\
Source File Names
Source File Paths
Source File Data Range
Template File Paste Range
File Status
File A_21_11_2017.xlsx
c:\users\folder A\
A1:A30
C1:C30
File Available. Data Copied
File B_21_11_2017.xlsx
c:\users\folder B\
A5:A20
D5:D20
File Available. Data Copied
File C_21_11_2017.xlsx
c:\users\folder C\
A2:A5
C2:C5
File Available. Data Copied
File D_21_11_2017.xlsx
c:\users\folder D\
E7:E20
F7:F20
File Not Available
File E_21_11_2017.xlsx
c:\users\folder E\
C4:C12
I4:I12
File Available. Data Copied
File F_21_11_2017.xlsx
c:\users\folder F\
B2:B17
K2:K17
File Available. Data Copied
File G_21_11_2017.xlsx
c:\users\folder G\
D1:D18
F1:F18
File Available. Data Copied
File H_21_11_2017.xlsx
c:\users\folder H\
F14:F15
L14:L15
File Not Available
File I_21_11_2017.xlsx
c:\users\folder I\
K12:K15
J12:J15
File Available. Data Copied

<tbody>
</tbody>
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
I'm not really sure what your question is, but I think having a macro add formulas to the second workbook that reference the first workbook would be easier. Also, column D can just have the first cell referenced as long as it's a linear reference (no transposing or modifying of the shape/size of copied range).
 
Upvote 0
I'm not really sure what your question is, but I think having a macro add formulas to the second workbook that reference the first workbook would be easier. Also, column D can just have the first cell referenced as long as it's a linear reference (no transposing or modifying of the shape/size of copied range).


I don't want to hard code any path or file names into the macro so will have the above grid/excel table of all filenames and references in the macro file which will open the template and open each file and copy and paste the data as per the source and destination range mentioned in the column C and D. I need a sample script, something like below but every reference to be sourced from the macro file.

Code:
Sub CopyRange()    Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Users\xbv\Desktop\group1\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            .Sheets("Appendix B").Range("C6:F" & Range("C" & Rows.Count).End(xlUp).Row + 1).Copy wkbDest.Sheets("Master1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Sheets("Appendix C").Range("D6:Y" & Range("D" & Rows.Count).End(xlUp).Row + 1).Copy wkbDest.Sheets("Master2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Sheets("Appendix D").Range("D5:I" & Range("D" & Rows.Count).End(xlUp).Row + 1).Copy wkbDest.Sheets("Master3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Here would be the basic shell for the program. Since everything is listed in the table in your first post, it's just a case of referencing the cell values in the loop.

Code:
Sub WorkbookLoop()
    Dim i As Integer
    Dim finalRow As Integer
    
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To finalRow
        'Workbook open, range copy, range paste, close workbook.
    Next i
End Sub
 
Upvote 0
Here would be the basic shell for the program. Since everything is listed in the table in your first post, it's just a case of referencing the cell values in the loop.

Code:
Sub WorkbookLoop()
    Dim i As Integer
    Dim finalRow As Integer
    
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To finalRow
        'Workbook open, range copy, range paste, close workbook.
    Next i
End Sub



Ok. I have added the workbook open, range copy, range paste and close workbook code but its still hard coded. How should I give the cell references to pick the values in the same.

Code:
Sub WorkbookLoop()    Dim i As Integer
    Dim finalRow As Integer
    
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To finalRow
        'Workbook open, range copy, range paste, close workbook.
        Workbooks.Open Filename:= Range("A4").value
    Range("H7:H11").Select ' range hardcoded
    Selection.Copy
    Windows("Template").Activate
    Range("G7:G11").Select 'range hardcoded
    ActiveSheet.Paste
    Windows("A_21_11_2017.xlsx").Activate 'workbook name is hardcoded
     ActiveWindow.Close
    Windows("Template").Activate 'workbook name is hardcoded
        
    Next i
End Sub
 
Upvote 0
Ok. I have added the workbook open, range copy, range paste and close workbook code but its still hard coded. How should I give the cell references to pick the values in the same.

Code:
Sub WorkbookLoop()    Dim i As Integer
    Dim finalRow As Integer
    
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To finalRow
        'Workbook open, range copy, range paste, close workbook.
        Workbooks.Open Filename:= Range("A4").value
    Range("H7:H11").Select ' range hardcoded
    Selection.Copy
    Windows("Template").Activate
    Range("G7:G11").Select 'range hardcoded
    ActiveSheet.Paste
    Windows("A_21_11_2017.xlsx").Activate 'workbook name is hardcoded
     ActiveWindow.Close
    Windows("Template").Activate 'workbook name is hardcoded
        
    Next i
End Sub

Also i want the workbook availability status to be updated in the column E if the workbook is not available.
 
Upvote 0
Pretty good try. The macro recorded is a little inefficient and it doesn't help with using variables. The benefit is that you have all the necessary information written in the table which makes a loop ideal in this solution. Here is a condensed version that tries to fix the hardcoded issues:

Code:
Sub WorkbookLoop()
    Dim i As Integer
    Dim finalRow As Integer
    Dim template As Worksheet
    
    template = Workbooks("Template").Sheets(1)
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 4 To finalRow
        Workbooks.Open Filename:=Range("B" & i).Value & Range("A" & i).Value

        Range(template.Range("C" & i).Value).Copy Destination:=template.Range(template.Range("D" & i).Value)

        Workbooks(template.Range("A" & i).Value).Close SaveChanges:=False
    Next i

    MsgBox "Done."

End Sub

The start of the loop sets up a variable (i) that counts from 4 to the value of finalRow (12 in your example):
Code:
For i = 4 To finalRow

You then use that "i" variable to identify the row value in your Range code:
Code:
Range("B" & i).Value

The copy/paste functionality can be condensed into a single line, but the range values might be a little hard to decipher:
Code:
Range(template.Range("C" & i).Value).Copy Destination:=template.Range(template.Range("D" & i).Value)

So, inside the loop, one line opens the workbook. The next copies the data over. And, the third closes that workbook. Then the code loops to the next "i" value and runs the three lines again until "i" is greater than the value of finalRow.

Now, the part of handling errors of missing workbooks is a little more complicated. I'll make another post after this one to go through that bit.
 
Upvote 0
Here is the error handling version that will annotate if the file was copied:
Code:
Sub WorkbookLoop()
    Dim i As Integer
    Dim finalRow As Integer
    Dim template As Worksheet
    
    template = Workbooks("Template").Sheets(1)
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    [COLOR=#0000ff]On Error GoTo MissingWB[/COLOR]
    For i = 4 To finalRow
        Workbooks.Open Filename:=Range("B" & i).Value & Range("A" & i).Value
        
        Range(template.Range("C" & i).Value).Copy Destination:=template.Range(template.Range("D" & i).Value)
        
        Workbooks(template.Range("A" & i).Value).Close SaveChanges:=False
        
[COLOR=#0000ff]        ThisWorkbook.Sheets(1).Range("E" & i).Value = "File Available. Data Copied"
NextWB:[/COLOR]
    Next i

    [COLOR=#0000FF]On Error GoTo 0[/COLOR]
    
    MsgBox "Done."
    
[COLOR=#0000ff]    Exit Sub
    
MissingWB:
    ThisWorkbook.Sheets(1).Range("E" & i).Value = "File Not Available"
    Resume NextWB[/COLOR]
End Sub

The added bits are in blue. Custom error handling can cause the code to jump around a bit, but allows the macro to perform a different action in the event there is an error. In this case, we're looking to catch the error that occurs when it tries to open a workbook that doesn't exist.

When an error occurs in the loop, the execution jumps down towards the bottom to execute the code under "MissingWB". It then resumes at the end of the loop (NextWB) to allow it to move on to the next row. After the loop is over, it returns the error handling back to default by setting the GoTo back to 0.
 
Upvote 0
Here is the error handling version that will annotate if the file was copied:
Code:
Sub WorkbookLoop()
    Dim i As Integer
    Dim finalRow As Integer
    Dim template As Worksheet
    
    template = Workbooks("Template").Sheets(1)
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    [COLOR=#0000ff]On Error GoTo MissingWB[/COLOR]
    For i = 4 To finalRow
        Workbooks.Open Filename:=Range("B" & i).Value & Range("A" & i).Value
        
        Range(template.Range("C" & i).Value).Copy Destination:=template.Range(template.Range("D" & i).Value)
        
        Workbooks(template.Range("A" & i).Value).Close SaveChanges:=False
        
[COLOR=#0000ff]        ThisWorkbook.Sheets(1).Range("E" & i).Value = "File Available. Data Copied"
NextWB:[/COLOR]
    Next i

    [COLOR=#0000FF]On Error GoTo 0[/COLOR]
    
    MsgBox "Done."
    
[COLOR=#0000ff]    Exit Sub
    
MissingWB:
    ThisWorkbook.Sheets(1).Range("E" & i).Value = "File Not Available"
    Resume NextWB[/COLOR]
End Sub

The added bits are in blue. Custom error handling can cause the code to jump around a bit, but allows the macro to perform a different action in the event there is an error. In this case, we're looking to catch the error that occurs when it tries to open a workbook that doesn't exist.

When an error occurs in the loop, the execution jumps down towards the bottom to execute the code under "MissingWB". It then resumes at the end of the loop (NextWB) to allow it to move on to the next row. After the loop is over, it returns the error handling back to default by setting the GoTo back to 0.


is it possible, If multiple ranges need to be copied from the same file then it should not open, copy and close the file multiple times, it should open it once copy all ranges and paste all ranges and then close the workbook. can this be achieved in the above code.
 
Upvote 0
It can if we added additional code to accommodate the additional requirements, but it depends on how that will be presented in the table. If the rows that correspond with the same workbook are not in consecutive rows, a nested loop would be needed to check for that. I would probably add the file path and the workbook name to variables to make it easier to code the comparison. Something like this:
Code:
Sub WorkbookLoop()
    Dim i As Integer
    [COLOR=#0000ff]Dim j As Integer[/COLOR]
    Dim finalRow As Integer
    [COLOR=#0000ff]Dim masterWb As Worksheet[/COLOR]
    Dim templateWb As Worksheet
    [COLOR=#0000ff]Dim sPath As String
    Dim sFileName As String[/COLOR]
    
    [COLOR=#0000ff]Set masterWb = ThisWorkbook.Sheets(1)
    Set templateWb = Workbooks("Template").Sheets(1)[/COLOR]
    
    finalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    On Error GoTo MissWB
    For i = 4 To finalRow
        [COLOR=#0000ff]sPath = masterWb.Range("B" & i).Value
        sFileName = masterWb.Range("A" & i).Value[/COLOR]
        
        [COLOR=#0000ff]If ThisWorkbook.Sheets(1).Range("E" & i) = "" Then[/COLOR]
            Workbooks.Open Filename:=[COLOR=#0000ff]sPath & sFileName[/COLOR]
            
            [COLOR=#0000ff]For j = i To finalRow
            
                If Cells(j, 2).Value = sPath And Cells(j, 1).Value = sFileName Then[/COLOR]
                    Range(masterWb.Range("C" & j).Value).Copy Destination:=templateWb.Range(masterWb.Range("D" & j).Value)
                    master.Range("E" & j).Value = "File Available. Data Copied"
                    
                [COLOR=#0000ff]End If
                
            Next j[/COLOR]
            Workbooks(templateWb.Range("A" & i).Value).Close SaveChanges:=False
            
        End If
        
NextWB:
    Next i
    
    On Error GoTo 0
    
    MsgBox "Done."
    
    [COLOR=#0000ff]Set masterWb = Nothing
    Set templateWb = Nothing[/COLOR]
    
    Exit Sub
    
MissWB:
    masterWb.Range("E" & i).Value = "File Not Available"
    Resume NextWB
End Sub

If you can control the table, you could make due with an If statement that checks for the same workbook in following rows.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,981
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top