Open and close source workbooks based on cell values in a Master Workbook

I am developing a macro that copies sheets from multiple different workbooks and pastes them into individual sheets into a Master workbook. I want the macro to close the source workbook(s) after copying the data from the desired sheet. Instead of replicating the code for each different source workbook that needs to get data pulled from (there are over 15 source workbooks to copy data from), I wanted some code to copy and close all the source workbooks based on cell values that are maintained on a sheet in the Master workbook. I was thinking I could incorporate a counter loop, and each time the data is copied and pasted into the Master workbook, that source workbook selected is then closed and then the next source workbook repeats the same process. For example, cell C10 in the Master workbook equals the file name of the 1st source workbook and cell C11 in the Master workbook equals the file name of the 2nd source workbook, and so forth. The loop would continue to run up until there is no file name in the next C cell. Please see the code below for what I have thus far. The code works but it is inefficient and it's not currently dynamic, which is what I am hoping to accomplish with this post. Thanks in advance for any help.

Sub Get_Source_Data()
Dim FolderPath As String, Filepath As String, Filename As String
Application.ScreenUpdating = False
'Folder directory path - cell F10 is equal to the directory path of the 1st source workbook,
' FolderPath = Dir(Sheets("Control").Range("F10").Value) '- this line doesn't seem to work unfortunately.

FolderPath = "C:\\\\"
Filepath = FolderPath & "*.xls*"
Filename = Dir(Filepath)

Do While Filename <> ""

Workbooks. Open (Folder Path & Filename)
Sheets("4.1 Operating").Select
Cells. Select
Application.CutCopyMode = False
Selection. Copy

Workbooks("2023-24 Master Budget.xlsm").Activate
Sheets(1).Select
Sheets(Range("D10").Value).Select
Cells. Select
ActiveSheet.Paste


Application.DisplayAlerts = False


'Close selected source workbook using exact file name  
Workbooks("2023-24 Budget_Commercialization.xlsx").Close SaveChanges:=False '- this is the name of 1st source workbook

'ATTEMPT TO SELECT WORKBOOK NAME BASED ON CELL VALUE IN MASTER WORKBOOK
'Workbooks(Workbooks("2023-24 Master Budget.xlsm").Select.Sheets("Control").Select.Range("c10").value).Close SaveChanges:=False
Application.ScreenUpdating = True

Filename = Dir

Loop
Application.DisplayAlerts = True
End Sub

excel

Formulas and Functions

HansVogelaar

Jan 16, 2023

MixMasterMike

Sub Get_Source_Data()
    Dim FolderPath As String, Filename As String
    Dim wbkSource As Workbook, wbkTarget As Workbook
    Dim wshNames As Worksheet, wshTarget As Worksheet
    Dim r As Long

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("2023-24 Master Budget.xlsm") ' or Thisworkbook
    Set wshNames = wbkTarget.Worksheets("Names") ' change as needed!
    r = 10
    Do
        FolderPath = wshNames.Range("F" & r).Value
        If Right(FolderPath, 1) <> "\" Then
            FolderPath = FolderPath & "\"
        End If
        Filename = wshNames.Range("C" & r).Value
        Set wbkSource = Workbooks.Open(FolderPath & Filename)
        Set wshTarget = wbkTarget.Worksheets(wshNames.Range("D" & r).Value)
        wbkSource.Worksheets("4.1 Operating").Cells.Copy Destination:=wshTarget.Range("A1")
        wbkSource.Close SaveChanges:=False
        r = r + 1
    Loop Until wshNames.Range("C" & r).Value = ""
    Application.ScreenUpdating = True
End Sub

4 Replies

HansVogelaar

MVP

Jan 15, 2023

MixMasterMike

See if this works for you. You'll have to change the line

Set wshNames = wbkTarget.Worksheets("Names")

to reflect the name of the sheet containing the file names.

Sub Get_Source_Data()
    Dim FolderPath As String, Filename As String
    Dim wbkSource As Workbook, wbkTarget As Workbook
    Dim wshNames As Worksheet, wshTarget As Worksheet
    Dim r As Long

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("2023-24 Master Budget.xlsm") ' or Thisworkbook
    Set wshNames = wbkTarget.Worksheets("Names") ' change as needed!
    FolderPath = "C:\\\\" ' change as needed!
    r = 10
    Do
        Filename = wshNames.Range("C" & r).Value
        Set wbkSource = Workbooks.Open(FolderPath & Filename)
        Set wshTarget = wbkTarget.Worksheets(wshNames.Range("D" & r).Value)
        wbkSource.Worksheets("4.1 Operating").Cells.Copy Destination:=wshTarget.Range("A1")
        wbkSource.Close SaveChanges:=False
        r = r + 1
    Loop Until wshNames.Range("C" & r).Value = ""
    Application.ScreenUpdating = True
End Sub

MixMasterMike

Copper Contributor

Jan 16, 2023

HansVogelaar Thanks a lot for your response! I did have one more aspect to add - what if the folder path is different for each one of the files that I want to pull data from? I have the different file names listed in Column C of the Master workbook, and their corresponding folder paths located in Column F. For instance, cell C10 has the name of one file and cell F10 has that file's correct folder path.

Many thanks

HansVogelaar

MVP

Jan 16, 2023

MixMasterMike

Sub Get_Source_Data()
    Dim FolderPath As String, Filename As String
    Dim wbkSource As Workbook, wbkTarget As Workbook
    Dim wshNames As Worksheet, wshTarget As Worksheet
    Dim r As Long

    Application.ScreenUpdating = False
    Set wbkTarget = Workbooks("2023-24 Master Budget.xlsm") ' or Thisworkbook
    Set wshNames = wbkTarget.Worksheets("Names") ' change as needed!
    r = 10
    Do
        FolderPath = wshNames.Range("F" & r).Value
        If Right(FolderPath, 1) <> "\" Then
            FolderPath = FolderPath & "\"
        End If
        Filename = wshNames.Range("C" & r).Value
        Set wbkSource = Workbooks.Open(FolderPath & Filename)
        Set wshTarget = wbkTarget.Worksheets(wshNames.Range("D" & r).Value)
        wbkSource.Worksheets("4.1 Operating").Cells.Copy Destination:=wshTarget.Range("A1")
        wbkSource.Close SaveChanges:=False
        r = r + 1
    Loop Until wshNames.Range("C" & r).Value = ""
    Application.ScreenUpdating = True
End Sub

Forum Discussion

Open and close source workbooks based on cell values in a Master Workbook

4 Replies

Resources