Forum Discussion

Copper Contributor

Jan 15, 2023

Solved

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 copy...

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

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

MixMasterMike
Copper Contributor
Jan 16, 2023
HansVogelaar Awesome, thanks for the help! Much appreciated