Copying a range from all files within a folder and pasting into master workbook

Question

I'm fairly new to VBA so I apologize ahead of time. I've been getting involved with some complex operations and I would greatly appreciate some help or input.

With this macro, I am trying to:

Copy a specific range (2 column widths) from a specific sheet that is within all files in a given folder.
Paste the range values (and formatting if possible) in a column on the already open master workbook starting at B7 and moving over 2 columns for every new document so that the pasted data does not overlap.
Close files after copy/paste complete

As of right now I receive a

Run-time Error 9: Subscript out of range

for

Workbooks("RF_Summary_Template").Worksheets("Summary").Select

I know this is the least of my problems, though.

Below is my code:

Sub compile()

    Dim SummaryFile As String, SummarySheet As String, summaryColumn As Long
    Dim GetDir As String, Path As String
    Dim dataFile As String, dataSheet As String, LastDataRow As Long
    Dim i As Integer, FirstDataRow As Long


    '********************************

    RF_Summary_Template = ActiveWorkbook.Name  'summarybook
    Summary = ActiveSheet.Name     'summarysheet

    summaryColumn = Workbooks(RF_Summary_Template).Sheets(Summary).Cells(Columns.Count, 1).End(xlToLeft).Column + 1
    CreateObject("WScript.Shell").Popup "First, browse to the correct directory, select ANY file in the directory, and click Open.", 2, "Select Install Base File"

    GetDir = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

    If GetDir <> "False" Then
        Path = CurDir & "\"
    Else
        MsgBox "Directory not selected"
        Exit Sub
    End If

    Application.ScreenUpdating = False
    dataFile = Dir(Path & "*.xls")

    While dataFile <> ""
        Workbooks.Open (dataFile)
        Worksheets("Dashboard").Activate
        ActiveSheet.Range("AY17:AZ35").Copy

        Workbooks("RF_Summary_Template").Worksheets("Summary").Select
        Range("B8").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Workbooks(dataFile).Close
        summaryColumn = summaryColumn + 2

        dataFile = Dir()
    Wend

    Workbooks(RF_Summary_Template).Save
    Application.ScreenUpdating = True

End Sub

Thanks a million

You are always copying this range? `Range("AY17:AZ35")`. And how do you consolidate it in the master workbook? By column increment always starting at row 8? — L42, Oct 29 '15 at 03:20
Yes, this is the range that will always be copied (all docs are based off a template). In the master sheet, Column A has the name of each field. I need each copied field to be pasted to the right of this column. The first range will be pasted into B8:C24. — jamboree11, Oct 29 '15 at 03:28
For the "subscript out of range" error, lose the quotation marks around `RF_Summary_Template` - it's a variable and not a sheet name. You should have this instead: `Workbooks(RF_Summary_Template).Worksheets("Summary").Select` — barrowc, Oct 29 '15 at 03:28
@barrowc - **Summary** is a string var as well. Neither should have been quoted. — , Oct 29 '15 at 03:39
Good catch @Jeeped. Also, neither variable is declared in the given code whereas variables called "SummaryFile" and "SummarySheet" are declared but never used — barrowc, Oct 29 '15 at 04:08

score 1 · Accepted Answer · 2015-10-30T16:12:52.707

I hope this helps. Run the procedure "CopyDataBetweenWorkBooks"

Sub CopyDataBetweenWorkbooks()

    Dim wbSource As Workbook
    Dim shTarget As Worksheet
    Dim shSource As Worksheet
    Dim strFilePath As String
    Dim strPath As String

    ' Initialize some variables and
    ' get the folder path that has the files
    Set shTarget = ThisWorkbook.Sheets("Summary")
    strPath = GetPath

    ' Make sure a folder was picked.
    If Not strPath = vbNullString Then

        ' Get all the files from the folder
        strfile = Dir$(strPath & "*.xls", vbNormal)

        Do While Not strfile = vbNullString

            ' Open the file and get the source sheet
            Set wbSource = Workbooks.Open(strPath & strfile)
            Set shSource = wbSource.Sheets("Dashboard")


            'Copy the data
            Call CopyData(shSource, shTarget)

            'Close the workbook and move to the next file.
            wbSource.Close False
            strfile = Dir$()
        Loop
    End If

End Sub

' Procedure to copy the data.
Sub CopyData(ByRef shSource As Worksheet, shTarget As Worksheet)

    Const strRANGE_ADDRESS As String = "AY17:AZ35"

    Dim lCol As Long

    'Determine the last column.
    lCol = shTarget.Cells(8, shTarget.Columns.Count).End(xlToLeft).Column + 1

    'Copy the data.
    shSource.Range(strRANGE_ADDRESS).Copy
    shTarget.Cells(8, lCol).PasteSpecial xlPasteValuesAndNumberFormats

    ' Reset the clipboard.
    Application.CutCopyMode = xlCopy

End Sub


' Fucntion to get the folder path
Function GetPath() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .ButtonName = "Select a folder"
        .Title = "Folder Picker"
        .AllowMultiSelect = False

        'Get the folder if the user does not hot cancel
        If .Show Then GetPath = .SelectedItems(1) & "\"

    End With

End Function

I hope this helps :)

Hi @Alfredo Lopez, First I'd like to say I really appreciate the help. However, I am running into error 1004 (copy of "....." file cannot be found). `Set wbSource = Workbooks.Open(strFilePath)` is highlighted as the source of the error. Can you please help me identify what's wrong? The file is definitely there, as it is pulling the name of it. Thanks! — jamboree11, Oct 30 '15 at 00:25
Hi, I am sorry I totally forgoit about this. Look at the updated code. baseically the changes are in this line Workbooks.Open(strPath & strfile) — , Oct 30 '15 at 16:13

score 0 · Answer 2 · edited Nov 02 '20 at 01:00

With the help of this code you can copy all workbooks and worksheets data into one workbook

Sub copydata()

Dim fso As Scripting.FileSystemObject
Dim fill As Scripting.File
Dim oldfolder As String
Dim newfolder As String
Dim subfolder As Folder
Dim myfolder As Folder
Dim fd As FileDialog
Dim loopcount As Integer
Dim wb
Dim wb2 As Workbook
Dim rr As Range

Set fso = New Scripting.FileSystemObject

Set wb = ThisWorkbook

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.Title = "Please Select Folder to copy"
fd.ButtonName = "Go!"
fd.Show

oldfolder = fd.SelectedItems(1)

Set myfolder = fso.GetFolder(oldfolder)

'Application.ScreenUpdating = False

Application.EnableEvents = False
 

For Each subfolder In myfolder.SubFolders

    For Each fill In subfolder.Files
            If fill Like "*.xlsm" Or fill Like "*.xlsx" Or fill Like ".*xls" Then
            'fill.Range("A1:Z100").Copy
            Set wb2 = Application.Workbooks.Open(fill,0 , True)
            wb2.Activate
            For loopcount = 1 To wb2.Worksheets.Count
            wb2.Activate
            Worksheets(loopcount).Activate
            Range("A1:Z300").Copy          'Replace your range
            wb.Activate
            Sheet1.Activate
            Set rr = Range("A:A").Find("", Range("A1"))
            rr.Select
            ActiveSheet.Paste
            ActiveCell.Offset(1, 0).Select
            Next loopcount
            wb2.Close False
            End If
            
        Application.CutCopyMode = False
        
        Debug.Print fill.Name
    
    Next fill
    
Next subfolder
        MsgBox "Done"

    For Each fill In myfolder.Files
        Application.DisplayAlerts = False
    
         If fill Like "*.xlsm" Or fill Like "*.xlsx" Or fill Like ".*xls" Or fill Like "*.xlsb" Then
            'fill.Range("A1:Z100").Copy
            Set wb2 = Application.Workbooks.Open(fill, 0, True)
            wb2.Activate
            
            For loopcount = 1 To wb2.Worksheets.Count
        
            wb2.Activate
            Worksheets(loopcount).Activate
            
            Range("A:Z").EntireColumn.Hidden = False
            
            Range("A1:Z1").AutoFilter
            Range("A1:Z300").Copy
            wb.Activate
            
            Sheet1.Activate
            Set rr = Range("A:A").Find("", Range("A1"))
            rr.Select
            ActiveSheet.Paste
            ActiveCell.Offset(1, 0).Select
            Next loopcount
            wb2.Close False
            End If
            
        Application.CutCopyMode = False
        
        Debug.Print fill.Name
        
    Next fill
Application.EnableEvents = True

End Sub

score -1 · Answer 3 · answered Jun 08 '20 at 14:53

Sub fdsdf()

'template is in the f_path
'files are under fpath\Raw Data\Ban


f_path = tree

Set wbTemplate = Workbooks.Open(Filename:=f_path & "\DEMAND_Template.xlsx")
MyFolder = f_path & "\Raw Data\Ban"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Set wbIB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile)
wbIB.Activate

Sheets("Sheet1").Select

r_cnt = ActiveSheet.UsedRange.Rows.Count
ran1 = "12:" & r_cnt
Rows(ran1).Select
Selection.Copy
wbTemplate.Select

Sheets("Sheet1").Select
r_cnt1 = ActiveSheet.UsedRange.Rows.Count
ran2 = Sheets("Sheet1").Range("A1048576").End(xlUp).Row + 1
Range("A" & ran2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
wbIB.Close False

MyFile = Dir
Loop

wbTemplate.Save

End Sub

Why did you post two answers? Are they different solutions? Are they to be used together? — Blastfurnace, Jun 10 '20 at 10:58

score -1 · Answer 4 · answered Jun 08 '20 at 16:55

Sub final_consolidate()

f_path = "tree"

strFileToOpenIB = Application.GetOpenFilename(Title:="Please select the Consolidated file for Bangladesh", FileFilter:="Excel Files *.xlsx* (*.xlsx*),")
Set wbIB = Workbooks.Open(strFileToOpenIB)
wbIB.Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
wbIB.Activate
Sheets("Sheet2").Select
Sheets("Sheet2").Copy After:=Workbooks("Book1").Sheets(1)
wbIB.Activate
ActiveWorkbook.Close
Windows("Book1").Activate

strFileToOpenIB = Application.GetOpenFilename(Title:="Please select the Consolidated file for SriLanka", FileFilter:="Excel Files *.xlsx* (*.xlsx*),")
Set wbIB = Workbooks.Open(strFileToOpenIB)
wbIB.Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Workbooks("Book1").Sheets(2)
wbIB.Activate
Sheets("Sheet2").Select
Sheets("Sheet2").Copy After:=Workbooks("Book1").Sheets(3)
wbIB.Activate
ActiveWorkbook.Close
Windows("Book1").Activate

ActiveWorkbook.SaveAs Filename:=f_path, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


End Sub

Hi, welcome to StackOverflow! Thanks for helping people solve their problems by answering questions here. I would recommend reading through [this help page](https://stackoverflow.com/help/how-to-answer) to learn more on how to write a good answer. I would also suggest adding some context as to what your code is doing and what you changed to solve the problem. — Yashovardhan99, Jun 08 '20 at 18:54

Copying a range from all files within a folder and pasting into master workbook

4 Answers4

Linked