Merge Data from Multiple Workbooks into One

CDThe1

New Member
Joined
Mar 27, 2016
Messages
10
Hello, I have seen variations of this question, but nothing that fits for me. Here's what I want.

I have a "master" file and about 50 source files I want to extract data from. (I just want to copy one column or range from the source files). I need a VBA that will open the source file "ABC" with one sheet named "1000" and paste in into the "master" file in a sheet with the same name. The next source file is "XYZ" with one sheet named "1200" and copy it in the master file on sheet "1200."

The trouble is, the source filenames will change from one month to the next., so I would need to reference a specific cell for the correct filename to use.

Hope that makes sense.

Thanks in advance.
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,681
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Try this:
1. When You see Folder Select Window, Only Select folder that have Source file Not Open it
2. Change Save as Line Address to what you want. After last / is file name that saves.
3. this copy all data at each sheets have data. if you want specific range, we should define it at code
VBA Code:
Sub ImportFiles()
Dim wbOpen As Workbook, wbNew As Workbook, fName As String, strPath As String
Dim xStrPath As String, xStrName As String, xStrFName As String, xArr As Variant
Dim xWS As Worksheet, xMWS As Worksheet, xTWB As Workbook, Sheet As Worksheet
Dim xStrAWBName As String,  Lr As Integer, Sh1 as Worksheet, FolderName As String
Dim FolderPath As String, fldr As FileDialog, sItem As String, FileName As String, CName As String, Cell As Range
On Error Resume Next
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
  
Set wbNew = Workbooks.Add
Set xTWB = ThisWorkbook
FileName = Dir(FolderPath & "*.xls*")
MsgBox ("Do you Want to Extract Files?")
'Comment out the 3 lines below to debug
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
Lr = xWs.Range("A" & Rows.Count).End(xlup).Row
If Lr > 1 Then
xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
xMWS.Name = xWS.Name
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
xTWB.SaveAs Filename:="C:\Users\swaroopa.bp\Desktop\C\Consolidation", FileFormat:=xlWorkbookNormal
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation=xlCalculationAutomatic
End Sub
 

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows
I have a "master" file and about 50 source files I want to extract data from.
Are the 50 source files in the same folder? If not, it would help you a lot for the long-term if they were. If that cannot be the case, it's okay. But just let us know so that we know how to set this up for you. And is the master file in the same folder or in a different location?

(I just want to copy one column or range from the source files). I need a VBA that will open the source file "ABC" with one sheet named "1000" and paste in into the "master" file in a sheet with the same name. The next source file is "XYZ" with one sheet named "1200" and copy it in the master file on sheet "1200."
Do you want to replace all contents in the existing column, or do you want to append the new content to the end of that existing column?

The trouble is, the source filenames will change from one month to the next., so I would need to reference a specific cell for the correct filename to use.
Either you will have to manually go and select each and everyone one of the 50 files, or at least make a copy of them and put them into the same folder before this program is run. We can easily do this if there is one folder path to look in for source files.
 

CDThe1

New Member
Joined
Mar 27, 2016
Messages
10
Are the 50 source files in the same folder? If not, it would help you a lot for the long-term if they were. If that cannot be the case, it's okay. But just let us know so that we know how to set this up for you. And is the master file in the same folder or in a different location?


Do you want to replace all contents in the existing column, or do you want to append the new content to the end of that existing column?


Either you will have to manually go and select each and everyone one of the 50 files, or at least make a copy of them and put them into the same folder before this program is run. We can easily do this if there is one folder path to look in for source files.
Hi.

Yes, all 50 files are in the same folder. I do want to overwrite the data in the range C10:C256 in my master file. Essentially, I need to go to each of the 50 files, match the sheet name in the master file and copy/paste special values in the range C10:C256. The folder name is "Dept Sheets" and the folder name will remain the same. The 50 filenames and my master file will change each month with a 2021-09 after the filename.
 

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Yes, all 50 files are in the same folder.
Great!
The folder name is "Dept Sheets" and the folder name will remain the same. The 50 filenames and my master file will change each month with a 2021-09 after the filename.
It doesn't matter what the folder name is. You can feel free to change it (and/or its location) in the future. Someone (maybe me) can do this for you. And when one of us does, we can simply provide you the ability to copy and past the full folder path name into that cell before you click on a button of sorts to run the program.

I do want to overwrite the data in the range C10:C256 in my master file. Essentially, I need to go to each of the 50 files, match the sheet name in the master file and copy/paste special values in the range C10:C256.
That is very helpful/specific! This is very doable!

EDIT:
So you just want to paste the values (not keep the formatting of the source files, keep the formatting of the master sheet), correct?
 

CDThe1

New Member
Joined
Mar 27, 2016
Messages
10
Yes. The formatting of both the master and source are the same. So, a paste special values would work.
Try this:
1. When You see Folder Select Window, Only Select folder that have Source file Not Open it
2. Change Save as Line Address to what you want. After last / is file name that saves.
3. this copy all data at each sheets have data. if you want specific range, we should define it at code
VBA Code:
Sub ImportFiles()
Dim wbOpen As Workbook, wbNew As Workbook, fName As String, strPath As String
Dim xStrPath As String, xStrName As String, xStrFName As String, xArr As Variant
Dim xWS As Worksheet, xMWS As Worksheet, xTWB As Workbook, Sheet As Worksheet
Dim xStrAWBName As String,  Lr As Integer, Sh1 as Worksheet, FolderName As String
Dim FolderPath As String, fldr As FileDialog, sItem As String, FileName As String, CName As String, Cell As Range
On Error Resume Next
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
 
Set wbNew = Workbooks.Add
Set xTWB = ThisWorkbook
FileName = Dir(FolderPath & "*.xls*")
MsgBox ("Do you Want to Extract Files?")
'Comment out the 3 lines below to debug
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
For Each xWS In ActiveWorkbook.Sheets
Lr = xWs.Range("A" & Rows.Count).End(xlup).Row
If Lr > 1 Then
xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
xMWS.Name = xWS.Name
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
xTWB.SaveAs Filename:="C:\Users\swaroopa.bp\Desktop\C\Consolidation", FileFormat:=xlWorkbookNormal
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation=xlCalculationAutomatic
End Sub
Hi and thanks for your help. I have a master file with each sheet in it already, so this macro basically creates a new sheet. I don't need a new sheet, just need to copy a specific range C10:C256 in each source file and paste it into the same range and same sheet name in my master file.
 

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Yes. The formatting of both the master and source are the same. So, a paste special values would work.

Hi and thanks for your help. I have a master file with each sheet in it already, so this macro basically creates a new sheet. I don't need a new sheet, just need to copy a specific range C10:C256 in each source file and paste it into the same range and same sheet name in my master file.
Okay, if no one beats me to it, I will work on it a little later tonight. (Got to take a break.)

I can just provide VBA code, as you're are correct. There is no need to add/modify your existing sheets and the code based on the description.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
2,681
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I need to go to each of the 50 files, match the sheet name in the master file and copy/paste special values in the range C10:C256.

1. What means Special Values? E.g. you want only values not formula OR ...
2. With my macro you can Select Folder don''t need folder name.
 

cmowla

Board Regular
Joined
Sep 21, 2021
Messages
243
Office Version
  1. 365
Platform
  1. Windows
I have just finished this mini project. I am going to upload a video explaining it after I post this.

But basically,
  1. Create a new sheet in your master workbook named "Data Retrieval Sheet" (without quotes).
  2. Copy and paste the folder path (for example, "C:\Users\Chris\Desktop\Source Files" (without quotes) ) and paste that into Cell A2 in the "Data Retrieval Sheet".
  3. Put the below code into a new standard VBA code module.
  4. Run the top-most sub in this code.

  • Note that this assumes that all of the source files are of file extension .xlsx.
  • If there is a mixture of .xls and .xlsx, this will code will NOT work properly. (It needs to be either all .xls or .xlsx. If all are .xls, then you need to change the argument ".xlsx" in the top-most sub to ".xls".)

VBA Code:
Option Explicit

Sub Test__Get_All_Source_File_Names_With_This_File_Extension_From_This_FolderPath_Along_With_All_Of_Their_Sheet_Names_And_Put_Them_Into_A_Directory_Table_In_This_Sheet()
Call Get_All_Source_File_Names_With_This_File_Extension_From_This_FolderPath_Along_With_All_Of_Their_Sheet_Names_And_Put_Them_Into_A_Directory_Table_In_This_Sheet( _
ThisWorkbook.Sheets("Data Retrieval Sheet").Range("A2").Value & "\", ".xlsx", _
"Data Retrieval Sheet", _
"C10:C256" _
)
End Sub
Sub Get_All_Source_File_Names_With_This_File_Extension_From_This_FolderPath_Along_With_All_Of_Their_Sheet_Names_And_Put_Them_Into_A_Directory_Table_In_This_Sheet( _
folderPath As String, _
desiredFileExtension As String, _
sheetWithDirectoryTable As String, _
rangeToCopyValuesFromEachSheet As String _
)

'This sub takes the folder path such that there is no "\" at the end.  If there is one, it's omitted.
If SubString(folderPath, Len(folderPath), Len(folderPath)) = "\" Then folderPath = SubString(folderPath, 1, Len(folderPath) - 1)

'-----------------------------------------------------------
'Create a Table of Directories in this Master Excel Workbook
'-----------------------------------------------------------
    With ThisWorkbook.Sheets(sheetWithDirectoryTable)
        .UsedRange.Value = ""
        .Range("A1").Value = "Folder Path of Source Files"
        .Range("A1").RowHeight = 50
        .Range("A1").WrapText = True
        .Range("A1").ColumnWidth = 50
        .Range("A2").Value = folderPath 'put the folder path name back for the future.
        .Range("B3").ColumnWidth = 50
        .Range("B3").Value = "Master File Name"
        .Range("B4") = ThisWorkbook.Name
        .Range("B5").Value = "Master File's Sheets:"
        .Range("B5").Font.Bold = True
    End With
  
    Call Put_This_Array_In_This_Workbook_In_This_Sheet_In_This_Column( _
    ThisWorkbook, _
    sheetWithDirectoryTable, 6, 2, _
    Return_All_Worksheet_Names_In_This_Excel_File(ThisWorkbook) _
    )

    Dim currentFileIndexNumber As Integer
    currentFileIndexNumber = 0
  
    Dim book As Workbook
    Dim currentFileExtension As String
    Dim currentFileName As String
    Dim C As Collection 'https://stackoverflow.com/a/28054165
    Dim Filee As Variant
    Set C = GetFilesIn(folderPath)
    For Each Filee In C
        currentFileName = Filee
        currentFileExtension = SubString(currentFileName, InStrRev(currentFileName, "."), Len(currentFileName))
        If desiredFileExtension = currentFileExtension Then
            currentFileName = SubString(currentFileName, InStrRev(currentFileName, "\") + 1, InStrRev(currentFileName, ".") - 1)
            currentFileIndexNumber = currentFileIndexNumber + 1
          
            Set book = Workbooks.Open(fileName:=folderPath & "\" & currentFileName & desiredFileExtension)
  
            Call Put_This_Array_In_This_Workbook_In_This_Sheet_In_This_Column( _
            ThisWorkbook, _
            sheetWithDirectoryTable, 6, 2 + currentFileIndexNumber, _
            Return_All_Worksheet_Names_In_This_Excel_File(book) _
            )
  
            With ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(5, currentFileIndexNumber + 2)
                .Value = book.Name
                .Font.Bold = True
            End With
            book.Close savechanges:=False
            Set book = Nothing
        End If
       
    Next Filee

ThisWorkbook.Sheets(sheetWithDirectoryTable).Range("B2").Formula = "=COUNTA(B3:B1000) + 2" 'It's unlikely an Excel file will have more than 1000 worksheets!
ThisWorkbook.Sheets(sheetWithDirectoryTable).Range("C2").Formula = "=COUNTA(C3:C1000) + 4"
ThisWorkbook.Sheets(sheetWithDirectoryTable).Range("C2:" & Column_Number_To_Letter(currentFileIndexNumber + 2) & "2").Formula = ThisWorkbook.Sheets(sheetWithDirectoryTable).Range("C2").Formula


'---------------------------------------------------------------------------------------
'Now search/compare the sheet names of This Workbook to those of the source Excel files'
'---------------------------------------------------------------------------------------
Dim lastRowWithSheetNamesForMasterWorkbook As Integer
lastRowWithSheetNamesForMasterWorkbook = ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(2, 2).Value

Dim lastRowWithDataSheetNamesForThisSourceWorkbook As Integer
Dim workbookIsAlreadyOpened As Boolean


Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim sheetNameToUpdate As String
j = 3
Do While j <= currentFileIndexNumber + 2 'This variable is now the total number of source files.  Counter for going across columns.
    lastRowWithDataSheetNamesForThisSourceWorkbook = ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(2, j).Value

    k = 6
    Do While k <= lastRowWithDataSheetNamesForThisSourceWorkbook 'Counter for going top to bottom in current source workbook column.
        workbookIsAlreadyOpened = False
        i = 6
        Do While i <= lastRowWithSheetNamesForMasterWorkbook 'Counter for going top to bottom in the master sheet workbook column.
            'Debug.Print j & ": " & lastRowWithDataSheetNamesForThisSourceWorkbook & ": " & k & ": " & i
            If ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(i, 2).Value = ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(k, j).Value Then
                sheetNameToUpdate = ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(i, 2).Value
                Debug.Print "Sheet '" & sheetNameToUpdate & "' from the master workbook is in the source Excel file: '" & ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(5, j).Value & "'"
                If workbookIsAlreadyOpened = False Then
                    Set book = Workbooks.Open(fileName:=folderPath & "\" & ThisWorkbook.Sheets(sheetWithDirectoryTable).Cells(5, j).Value)
                    workbookIsAlreadyOpened = True
                End If
                ThisWorkbook.Sheets(sheetNameToUpdate).Range(rangeToCopyValuesFromEachSheet).Value = book.Sheets(sheetNameToUpdate).Range(rangeToCopyValuesFromEachSheet).Value
            End If
            i = i + 1
        Loop
        If workbookIsAlreadyOpened = True Then book.Close savechanges:=False
        Set book = Nothing

        k = k + 1
    Loop
    j = j + 1
Loop

End Sub




Function GetFilesIn(Folder As String) As Collection
Dim F As String
Set GetFilesIn = New Collection
F = Dir(Folder & "\*")
Do While F <> ""
    GetFilesIn.Add F
    F = Dir
Loop
End Function


Sub Test__Put_This_Array_In_This_Workbook_In_This_Sheet_In_This_Column()
Call Put_This_Array_In_This_Workbook_In_This_Sheet_In_This_Column( _
ThisWorkbook, _
"Data Retrieval Sheet", 6, 2, _
Return_All_Worksheet_Names_In_This_Excel_File(ThisWorkbook) _
)
End Sub
Sub Put_This_Array_In_This_Workbook_In_This_Sheet_In_This_Column(book As Workbook, sheetName As String, startRow As Long, columnNumber As Integer, arr As Variant)
Dim i As Long
Dim j As Integer
j = 1
i = startRow
Do While j <= UBound(arr)
    book.Sheets(sheetName).Cells(i, columnNumber).Value = arr(j)
    i = i + 1
    j = j + 1
Loop

End Sub


Sub Test__Return_All_Worksheet_Names_In_This_Excel_File()
MsgBox Return_All_Worksheet_Names_In_This_Excel_File(ThisWorkbook)(1)
End Sub
Function Return_All_Worksheet_Names_In_This_Excel_File(book As Workbook)

ReDim arrayOfSheetNames(0 To 0) As String

Dim sht As Worksheet
For Each sht In book.Sheets
    If (sht.Visible = -1) And (sht.Name <> "Data Retrieval Sheet") Then  'If the sheet is visible in the current workbook,
        arrayOfSheetNames = Append_StringType(arrayOfSheetNames, sht.Name)
        'Debug.Print arrayOfSheetNames(UBound(arrayOfSheetNames))
    End If
Next sht

Return_All_Worksheet_Names_In_This_Excel_File = arrayOfSheetNames

End Function


Sub Test__Append_StringType()

ReDim sampleArray(1 To 2) As String
sampleArray(1) = "item 1"
sampleArray(2) = "item 2"

sampleArray = Append_StringType(sampleArray, "##Address_1 Line 1##")
MsgBox sampleArray(1)
MsgBox sampleArray(2)
End Sub
Function Append_StringType(arr As Variant, arg As Variant)
'Two possible errors from client subs:
'(1) arr is not of type variant.
'(2) arr is defined as Dim array() as Variant instead of ReDim array(1 to x) as variant.

    Dim lowerBOundOfInputArray As Integer
    lowerBOundOfInputArray = LBound(arr)

    Dim upperBoundOfInputArray As Integer
    upperBoundOfInputArray = UBound(arr)

    ReDim newArray(lowerBOundOfInputArray To upperBoundOfInputArray) As String
    newArray = arr
  
    ReDim Preserve newArray(lowerBOundOfInputArray To upperBoundOfInputArray + 1)
    newArray(upperBoundOfInputArray + 1) = arg
  
    Append_StringType = newArray

End Function


Sub Test__SubString()
MsgBox SubString("ABCDEF", 3, 5)
End Sub
Function SubString(inputString As String, Start As Integer, Finish As Integer)
On Error GoTo Quit
SubString = Mid(inputString, Start, Finish - Start + 1)
Quit:
End Function


Sub Test__Column_Number_To_Letter()
MsgBox Column_Number_To_Letter(4)
MsgBox Column_Number_To_Letter(44)
End Sub
Function Column_Number_To_Letter(columnNumber As Integer) As String
'From https://stackoverflow.com/questions/12796973/function-to-convert-column-number-to-letter
    Dim vArr
    vArr = Split(Cells(1, columnNumber).Address(True, False), "$")
    Column_Number_To_Letter = vArr(0)
End Function
 
Last edited:

Forum statistics

Threads
1,148,367
Messages
5,746,283
Members
424,006
Latest member
Metal_warrior

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
Top