Choose folder, loop thru files to copy data & paste in new master workbook

I have been working on something that really has me stumped, even after searching the internet for days (although I must admit I'm still quite the novice.)

I want my code to allow the user to choose the folder (which will be a sub-folder within a network drive), then loop through all excel files in that folder and copy the data from a specific sheet (same name in each file - "SUBMITTED BUDGET SUMMARY") for each of those files and paste it into my workbook to create a master summary sheet.

Note: The copied data needs to be pasted into the MASTER SUMMARY sheet as a link, and should leave a blank line between the data pasted from each file. So copy the data from workbook1 and paste it into MASTER SUMMARY workbook, leave a blank row, then paste the data from workbook2, leave a blank row, and so on.

I've piece-mealed the code below from various searches and tested it using a folder on my desktop. It worked beautifully, but now it won't work when I try to choose the ACTUAL folder containing my files, which is a sub folder on a shared network drive.

Here's my code:

Code:

---

Option Explicit
 
Sub merge_all__input_workbooks()
   
    Dim wkbDest As Workbook
    Dim wksDest As Worksheet
    Dim wkbSource As Workbook
    Dim wksSource As Worksheet
    Dim MyPath As String
    Dim MyFile As String
    Dim FolderName As String
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set wkbDest = ThisWorkbook
    Set wksDest = wkbDest.Worksheets("Sheet1")
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        On Error Resume Next
        FolderName = .SelectedItems(1)
        Err.Clear
        On Error Goto 0
    End With
   
    MyPath = FolderName
   
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
   
    MyFile = Dir(MyPath & "*.xls")
   
    Do While Len(MyFile) > 0
        Set wkbSource = Workbooks.Open(MyPath & MyFile)
        Set wksSource = wkbSource.Worksheets("SUBMITTED BUDGET SUMMARY")
       
        'COPIES TABLE RANGE (table name = SUMMARY) FROM INPUT WORKBOOK SUBMITTED BUDGET SUMMARY PAGE AND PASTES IT TO THE END OF THE SUMMARY SHEET
        Sheets("SUBMITTED BUDGET SUMMARY").Select
        Range("SUMMARY").Copy
        Windows("MASTER BUDGET SUMMARY - ALL BUDGET OFFICERS.xlsm").Activate
        With Sheets("Sheet1")
            .Activate
            .Cells(Rows.Count, 1).End(xlUp).Offset(2, 0).Select
            .Paste Link:=True
        End With
       
        wkbSource.Close savechanges:=False
        MyFile = Dir
    Loop
   
    Call format_all_summary_page
    Call summary_pivot
   
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Pivot Table"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Budget Summary Table"
    Sheets("Pivot Table").Select
   
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
   
    MsgBox "Completed...", vbInformation
   
End Sub

---

I've looked everywhere at various possible solutions and I can't figure it out!!! Any help would be MUCH appreciated!

Also posted here because I'm desperately trying to figure this out ASAP: Choose folder, loop thru files to copy data & paste in new master workbook

What's the error you are getting ? Why you need a link ? why don't you the paste the values ? Is there a benefit pasting as link over values ?

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg. 9gJzxwFcnPU9gORqKw5tW_
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxUbeYSvsBH2Gianox4AaABAg. 9VYH-07VTyW9gJV5fDAZNe
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgxLtKj969oiIu7zNb94AaABAg
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgyhQ73u0C3V4bEPhYB4AaABAg
https://www.youtube.com/watch?v=v_1iqtOnUMg&lc=UgzIElpI5OFExnUyrk14AaABAg. 9fsvd9zwZii9gMUka-NbIZ
https://www.youtube.com/watch?v=jdPeMPT98QU
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Quote:

---

Originally Posted by Admin

What's the error you are getting ? Why you need a link ? why don't you the paste the values ? Is there a benefit pasting as link over values ?

---

That's the weird thing - I was getting an error message at the very end of my code where I called the format_all_summary_page - because it hadn't retrieved any data from the files in the folder I chose! Argh!

I was recommended to check out this Ron de Bruin code (link below) and I was able to modify it a bit for my purposes. But being a nube at this, I'm not sure how/where to change the code so that instead of pasting the data as values, it will paste special - paste link (I need links because users may be changing data in the original workbooks and I need to make sure that it's also changed in the master summary workbook.)

Also, Ron de Bruin's code creates a new workbook as the "master" workbook where it pastes everything - but I already have my "master" workbook where I want it to paste. This workbook will be open and the code will be assigned to a button for the user to click. The name of my workbook will be "MASTER BUDGET SUMMARY" and the sheet it should paste the links into will be "Sheet1". Any idea how I could change the code to paste into my existing workbook instead of creating a new one? I'm really having a hard time deciphering this one!

Here's the link to Ron de Bruin's code: Merge data from all workbooks in a folder

Here's my edited code from Ron de Bruin (not including the basic codes in used to get the file names, find last cell, etc.):

Code:

---

Option Explicit

'The example macro below you can use to merge a fixed range or
'all cells from one or all worksheets from each workbook in a folder

'First we call the Function "Get_File_Names" to fill a array with all file names
'There are three arguments in this Function that we can change

'With the macro below you can browse to the folder instead of enter in in the code
'2) Subfolders = True if you want to include subfolders
'3) ExtStr = file extension of the files you want to merge
'  ExtStr examples are: "*.xls" , "*.csv" , "*.xlsx"
'  "*.xlsm" ,"*.xlsb" , for all Excel file formats use "*.xl*"
'  Do not change myReturnedFiles:=myFiles


'Then if there are files in the folder we call the macro "Get_Data"
'There are six arguments in this macro that we can change


'1) FileNameInA = True to add the path/file name in the A column
'2) PasteAsValues = True to paste as values (recommend)
'3) SourceShName = sheet name, if "" it will use the SourceShIndex and if "all" it copy from all worksheets
'4) SourceShIndex = to avoid problems with different sheet names use the index (1 is the first worksheet)
'5) SourceRng = Range you want to copy. Tip: "A:F" will copy all cells with data in this six columns
'6) StartCell = Enter the first cell and the macro will copy from that cell till the last cell on the worksheet
'  If StartCell = "" then it use the SourceRng
'  Do not change myReturnedFiles:=myFiles


'The example below will merge THE DATA FROM THE TABLE NAMED "SUMMARY" from the THIRD worksheet of each file

Sub RDB_Merge_Data_Browse()
    Dim myFiles As Variant
    Dim myCountOfFiles As Long
    Dim oApp As Object
    Dim oFolder As Variant

    Set oApp = CreateObject("Shell.Application")

    'Browse to the folder
    Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
    If Not oFolder Is Nothing Then

        myCountOfFiles = Get_File_Names( _
                        MyPath:=oFolder.Self.Path, _
                        Subfolders:=False, _
                        ExtStr:="*.xl*", _
                        myReturnedFiles:=myFiles)

        If myCountOfFiles = 0 Then
            MsgBox "No files that match the ExtStr in this folder"
            Exit Sub
        End If

        Get_Data _
            FileNameInA:=False, _
            PasteLink:=True, _
            SourceShName:="SUBMITTED BUDGET SUMMARY", _
            SourceShIndex:=3, _
            SourceRng:="SUMMARY", _
            StartCell:="", _
            myReturnedFiles:=myFiles

    End If

End Sub

' Note: You not have to change the macro below, you only
' edit and run the RDB_Merge_Data above.

Sub Get_Data(FileNameInA As Boolean, PasteLink As Boolean, SourceShName As String, _
            SourceShIndex As Integer, SourceRng As String, StartCell As String, myReturnedFiles As Variant)
    Dim SourceRcount As Long
    Dim SourceRange As Range, destrange As Range
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim rnum As Long, CalcMode As Long
    Dim SourceSh As Variant
    Dim sh As Worksheet
    Dim I As Long

    'Change ScreenUpdating, Calculation and EnableEvents
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    'Add a new workbook with one sheet named "Combine Sheet"
    ' come back later and see if I can change this to my template workbook with Set BaseWks = Activeworkbook.Activeworksheets(Sheet1)
    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    BaseWks.Name = "Combine Sheet"

    'Set start row for the Data
    rnum = 1

    'Check if we use a named sheet or the index
    If SourceShName = "" Then
        SourceSh = SourceShIndex
    Else
        SourceSh = SourceShName
    End If

    'Loop through all files in the array(myFiles)
    For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
        Set mybook = Nothing
        On Error Resume Next
        Set mybook = Workbooks.Open(myReturnedFiles(I))
        On Error GoTo 0

        If Not mybook Is Nothing Then

            If LCase(SourceShName) <> "all" Then

                'Set SourceRange and check if it is a valid range
                On Error Resume Next

                If StartCell <> "" Then
                    With mybook.Sheets(SourceSh)
                        Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells))
                        'Test if the row of the last cell >= then the row of the StartCell
                        If RDB_Last(1, .Cells) < .Range(StartCell).Row Then
                            Set SourceRange = Nothing
                        End If
                    End With
                Else
                    With mybook.Sheets(SourceSh)
                        Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng))
                    End With
                End If

                If Err.Number > 0 Then
                    Err.Clear
                    Set SourceRange = Nothing
                Else
                    'if SourceRange use all columns then skip this file
                    If SourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set SourceRange = Nothing
                    End If
                End If

                On Error GoTo 0

                If Not SourceRange Is Nothing Then

                    'Check if there enough rows to paste the data
                    SourceRcount = SourceRange.Rows.Count
                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "Sorry there are not enough rows in the sheet to paste"
                        mybook.Close savechanges:=False
                        BaseWks.Parent.Close savechanges:=False
                        GoTo ExitTheSub
                    End If

                    'Set the destination cell
                    If FileNameInA = True Then
                        Set destrange = BaseWks.Range("B" & rnum)
                        With SourceRange
                            BaseWks.Cells(rnum, "A"). _
                                    Resize(.Rows.Count).Value = myReturnedFiles(I)
                        End With
                    Else
                        Set destrange = BaseWks.Range("A" & rnum)
                    End If

                    'Copy/paste the data
                    If PasteLink = True Then
                        With SourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = SourceRange.Value
                    Else
                        SourceRange.Copy destrange
                    End If

                    rnum = rnum + SourceRcount
                End If

                'Close the workbook without saving
                mybook.Close savechanges:=False

            Else

                'Loop through all sheets in mybook
                For Each sh In mybook.Worksheets

                    'Set SourceRange and check if it is a valid range
                    On Error Resume Next

                    If StartCell <> "" Then
                        With sh
                            Set SourceRange = .Range(StartCell & ":" & RDB_Last(3, .Cells))
                            If RDB_Last(1, .Cells) < .Range(StartCell).Row Then
                                Set SourceRange = Nothing
                            End If
                        End With
                    Else
                        With sh
                            Set SourceRange = Application.Intersect(.UsedRange, .Range(SourceRng))
                        End With
                    End If

                    If Err.Number > 0 Then
                        Err.Clear
                        Set SourceRange = Nothing
                    Else
                        'if SourceRange use almost all columns then skip this file
                        If SourceRange.Columns.Count > BaseWks.Columns.Count - 2 Then
                            Set SourceRange = Nothing
                        End If
                    End If
                    On Error GoTo 0

                    If Not SourceRange Is Nothing Then

                        'Check if there enough rows to paste the data
                        SourceRcount = SourceRange.Rows.Count
                        If rnum + SourceRcount >= BaseWks.Rows.Count Then
                            MsgBox "Sorry there are not enough rows in the sheet to paste"
                            mybook.Close savechanges:=False
                            BaseWks.Parent.Close savechanges:=False
                            GoTo ExitTheSub
                        End If

                        'Set the destination cell
                        If FileNameInA = True Then
                            Set destrange = BaseWks.Range("C" & rnum)
                            With SourceRange
                                BaseWks.Cells(rnum, "A"). _
                                        Resize(.Rows.Count).Value = myReturnedFiles(I)
                                BaseWks.Cells(rnum, "B"). _
                                        Resize(.Rows.Count).Value = sh.Name
                            End With
                        Else
                            Set destrange = BaseWks.Range("A" & rnum)
                        End If

                        'Copy/paste the data
                        If PasteLink = True Then
                            With SourceRange
                                Set destrange = destrange. _
                                                Resize(.Rows.Count, .Columns.Count)
                            End With
                            destrange.Link = SourceRange.Value
                        Else
                            SourceRange.Copy destrange
                        End If

                        rnum = rnum + SourceRcount
                    End If

                Next sh

                'Close the workbook without saving
                mybook.Close savechanges:=False
            End If
        End If

        'Open the next workbook
    Next I

    'Set the column width in the new workbook
    BaseWks.Columns.AutoFit

ExitTheSub:
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
        .DisplayAlerts = False
    End With
End Sub

---