Merge different Excel worksheet from different workbooks into one workbook

rimcus

New Member
Joined
Jan 29, 2021
Messages
7
Office Version
  1. 2019
Platform
  1. MacOS
Hello everyone,

I want to create a database of my old clients from the quotes I've made in the past. To do so I thought about merging all the workbooks in one (Every quote has 3 worksheets, only one is filled), then filling the database with the key informations thanks to the INDIRECT command.

The Problem is that I have many files and cant merge them manually, and I'm using a mac so can't do it with power query, I tried many VBA codes I found online with no results. All the workbooks are in the same file. Here's an example of a code I found in this forum :

VBA Code:
Public Sub ConslidateWorkbooks()Dim this As Workbook
Dim Sheet As Worksheet
Dim Nextcell As Range
Dim FolderPath As String
Dim Filename As String
Dim Lastrow As Long

    Application.ScreenUpdating = False
    
    FolderPath = Environ("userprofile") & "\Documents\Reports\"
    Filename = Dir(FolderPath & "*.xls*")
    Do While Filename <> ""
    
        Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
        
        For Each Sheet In ActiveWorkbook.Sheets
        
            Call SheetExists(Sheet.Name, ThisWorkbook, True)
            Lastrow = ThisWorkbook.Worksheets(Sheet.Name).Range("A1").SpecialCells(xlCellTypeLastCell).Row
            If Lastrow = 1 And ThisWorkbook.Worksheets(Sheet.Name).Range("A1").Value = vbNullString Then Lastrow = 0
            
            Sheet.UsedRange.Copy ThisWorkbook.Worksheets(Sheet.Name).Cells(Lastrow + 1, "A")
        Next Sheet
        
        Workbooks(Filename).Close
        Filename = Dir()
    Loop
    
    Application.ScreenUpdating = True
End Sub

Public Function SheetExists( _
    ByVal Name As String, _
    Optional ByRef Wb As Workbook, _
    Optional ByVal Create As Boolean = False) As Boolean
Dim res As Boolean

    If Wb Is Nothing Then Set Wb = ActiveWorkbook
    On Error Resume Next
    res = CBool(Not Wb.Worksheets(Name) Is Nothing)
    If Not res And Create Then
    
        Wb.Worksheets.Add After:=Wb.Worksheets(Wb.Worksheets.Count)
        Wb.Worksheets(Wb.Worksheets.Count).Name = Name
    End If
    SheetExists = res End Function

Thank you for reading me
 
I think you want all files at one sheet, then I add each file at the end of previous at one sheet.
if you want each worksheet at separate sheet try this.
VBA Code:
Sub ImportFiles()
Dim wbNew As Workbook, strPath As String, xWS As Worksheet, xMWS As Worksheet, xTWB As Workbook
Dim xStrAWBName As String, Sh1 As Worksheet, FolderName As String, R As Long, Lr1 As Long
Dim FolderPath As String, fldr As FileDialog, sItem As String, FileName As String, Lr2 As Long
Dim LC As Long
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
Set Sh1 = xTWB.Sheets("Sheet1")
FileName = Dir(FolderPath & "*.xls*")
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
R = Application.WorksheetFunction.CountA(xWS.Range("A1:Z200"))
If R > 0 Then
xWS.Copy After:=xTWB.Sheets(xTWB.Sheets.Count)
Set xMWS = xTWB.Sheets(xTWB.Sheets.Count)
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
xTWB.SaveAs FileName:="D:\Consolidation", FileFormat:=xlWorkbookNormal
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
Solution

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Hi, So I'm on a windows laptop using excel 2010, i tried the code, it made me choose a folder, i chose the one with the files i want to merge, afterwards it opened and closed excel files very fast and created a new workbook, but it was completely empty.
 
Upvote 0
What is your files format at folder, Is it excel file, Csv files , ...?
 
Upvote 0
But whatever, i've downloaded power query and it works good, just gonna look some tutorials on how to use it. thanks everyone
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

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
Back
Top