Combine multiple sheets one below the other (sheets not in table format)

asivaraman

New Member
Joined
Aug 12, 2019
Messages
12
Hello SMEs
I have an excel file with multiple sheets.
First 2 columns are the same type of data in all the sheets.

I tried powerquery to append, but somehow it doesnt come out right.
Note: The sheets are not table formatted, that is why its not working out with Powerquery.

Can anyone provide a VBA script to combine columns from all the sheets into one? Any other solution is fine as well.

Reference image:
1625843411236.png

You can see there are multiple tabs/sheets below. I need a script that can copy col A, B, C ... from all the sheets, one below the other into a single sheet/workbook.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,300
This method copies all columns A:Z to a main sheet named IMPORT :

VBA Code:
Option Explicit


Public Sub CombineDataFromAllSheets()

    Dim wksSrc As Worksheet, wksDst As Worksheet
    Dim rngSrc As Range, rngDst As Range
    Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long
    
    'Notes: "Src" is short for "Source", "Dst" is short for "Destination"
    
    'Set references up-front
    Set wksDst = ThisWorkbook.Worksheets("Import")
    lngDstLastRow = LastOccupiedRowNum(wksDst) '<~ defined below
    lngLastCol = LastOccupiedColNum(wksDst) '<~ defined below
    
    'Set the initial destination range
    Set rngDst = wksDst.Cells(lngDstLastRow, 1)
    
    'Loop through all sheets
    For Each wksSrc In ThisWorkbook.Worksheets
    
        'Make sure we skip the "Import" destination sheet!
        If wksSrc.Name <> "Import" Then
            
            'Identify the last occupied row on this sheet
            lngSrcLastRow = LastOccupiedRowNum(wksSrc)
            
            'Store the source data then copy it to the destination range
            With wksSrc
                Set rngSrc = .Range("A1:Z100")
                rngSrc.Copy Destination:=rngDst
            End With
            
            'Redefine the destination range now that new data has been added
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
            
        End If
    
    Next wksSrc

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng + 1   '<-- the + 1 places a blank row between tables
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,300
Here are two other methods :

Code:
Sub master_sheet()
    Dim wsM As Worksheet
    Set wsM = Sheets("Master")
    'assumes Master sheet is the first sheet
    For x = 2 To Worksheets.Count
        Sheets(x).UsedRange.Copy Destination:=wsM.Cells(1, wsM.UsedRange.Columns(wsM.UsedRange.Columns.Count).Column + 1)
    Next x
    wsM.Columns("A").Delete
End Sub

ANOTHER WAY:

Sub master_sheet()

    Dim wsM As Worksheet
    Set wsM = Sheets("Master")
    
    'assumes Master sheet is the first sheet
    For x = 2 To Worksheets.Count
        Sheets(x).UsedRange.Copy Destination:=wsM.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
        
    Next x
    wsM.Columns("A").Delete
End Sub
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,300
And one last method :

Code:
Option Explicit

Sub Maybe()
    Dim sh As Worksheet
    If Not [ISREF(Combined!A1)] Then
        Sheets.Add(, Sheets(Sheets.Count)).Name = "Combined"
    Else
        Sheets("Combined").UsedRange.EntireColumn.Delete
    End If
    'Sheets("Sheet2").Rows(1).Copy Sheets("Combined").Cells(1, 1)  ' Not needed
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> "Combined" Then sh.UsedRange.Offset(1).Copy Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next sh
End Sub
 

asivaraman

New Member
Joined
Aug 12, 2019
Messages
12

ADVERTISEMENT

Thank you Logit. Amazing.
It works perfect.
 

asivaraman

New Member
Joined
Aug 12, 2019
Messages
12

ADVERTISEMENT

Hello Logit,
I have one minor problem with the "last method" you posted.

Option Explicit

Sub Maybe()
Dim sh As Worksheet
If Not [ISREF(Combined!A1)] Then
Sheets.Add(, Sheets(Sheets.Count)).Name = "Combined"
Else
Sheets("Combined").UsedRange.EntireColumn.Delete
End If
'Sheets("Sheet2").Rows(1).Copy Sheets("Combined").Cells(1, 1) ' Not needed
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> "Combined" Then sh.UsedRange.Offset(1).Copy Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next sh
End Sub


The result removes the first row from all the sheets.
I am wondering which syntax to change so it copies all the rows one below the other.
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
4,300
VBA Code:
Sub Maybe()
    Dim sh As Worksheet
    If Not [ISREF(Combined!A1)] Then
        Sheets.Add(, Sheets(Sheets.Count)).Name = "Combined"
    Else
        Sheets("Combined").UsedRange.EntireColumn.Delete
    End If
    'Sheets("Sheet2").Rows(1).Copy Sheets("Combined").Cells(1, 1)  ' Not needed
    For Each sh In ActiveWorkbook.Sheets
        If sh.Name <> "Combined" Then sh.UsedRange.Copy Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Next sh
End Sub
 
Solution

asivaraman

New Member
Joined
Aug 12, 2019
Messages
12
Got it, its the UsedRange.Offset(1) that did it.
It works now.

Thank you again.
Arun
 

Forum statistics

Threads
1,147,734
Messages
5,742,861
Members
423,760
Latest member
photogfrog

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