unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
186
Office Version
  1. 2016
Platform
  1. Windows
Hi Guys,

Happy New year!

I found below code however, it seems like only column A of each sheet is being copied on the combined Sheet. Is it possible to adjust the range and copy everything except Row 1 for each sheet?

= = = = =

Sub Combine_Sheets()

Dim startRow, startCol, LastRow, lastCol As Long
Dim headers As Range

'Set Master sheet for consolidation
Set mtr = Worksheets("Combined")

Set wb = ThisWorkbook
'Get Headers
Set headers = Application.InputBox("Select the Headers", Type:=8)

'Copy Headers into master
headers.Copy mtr.Range("A1")
startRow = headers.Row + 1
startCol = headers.Column

Debug.Print startRow, startCol
'loop through all sheets
For Each ws In wb.Worksheets
'except the master sheet from looping
If ws.Name <> "Combined" Then
ws.Activate
LastRow = Cells(Rows.Count, startCol).End(xlUp).Row
lastCol = Cells(startRow, Columns.Count).End(xlToLeft).Column
'get data from each worksheet and copy it into Master sheet
Range(Cells(startRow, startCol), Cells(LastRow, lastCol)).Copy _
mtr.Range("A" & mtr.Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
Next ws

Worksheets("Combined").Activate

End Sub

Any help will be much appreciated. :)

Regards!

= = =
Source: Consolidate/Merge multiple worksheets into one master sheet using VBA
= = =
 

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

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
186
Office Version
  1. 2016
Platform
  1. Windows
Yes, I did.

I have one sheet that has format like this so I'm not quite sure if this has to do with the format.

Name
Number 1
Number 2Owen G
Number 3
Number 4St Louie
Number 5PO Box 2000
Number 6Ohio
Number 7Note

Thank you!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,488
Office Version
  1. 365
Platform
  1. Windows
Yes, I did.
OK. The problem is that the code uses the headings to determine the columns to copy and since you only have one heading ... :)

Try this instead. It assumed the 'Combined' sheet exists but has nothing in it.

VBA Code:
Sub Combine_Sheets_v2()
  Dim ws As Worksheet
  Dim nr As Long
  
  nr = 1
  For Each ws In Worksheets
    If ws.Name <> "Combined" Then
      With ws.UsedRange
        .Offset(IIf(nr = 1, 0, 1)).Copy Destination:=Sheets("Combined").Range("A" & nr)
        nr = nr + .Rows.Count - IIf(nr = 1, 0, 1)
      End With
    End If
  Next ws
End Sub
 

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
186
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

OK. The problem is that the code uses the headings to determine the columns to copy and since you only have one heading ... :)

Try this instead. It assumed the 'Combined' sheet exists but has nothing in it.

VBA Code:
Sub Combine_Sheets_v2()
  Dim ws As Worksheet
  Dim nr As Long
 
  nr = 1
  For Each ws In Worksheets
    If ws.Name <> "Combined" Then
      With ws.UsedRange
        .Offset(IIf(nr = 1, 0, 1)).Copy Destination:=Sheets("Combined").Range("A" & nr)
        nr = nr + .Rows.Count - IIf(nr = 1, 0, 1)
      End With
    End If
  Next ws
End Sub
It's working! One thing, there's an available headers already in the Combine Sheet tab. Is it possible to adjust the code as it seems like the existing headers were deleted. :)
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,488
Office Version
  1. 365
Platform
  1. Windows
.. there's an available headers already in the Combine Sheet tab. Is it possible to adjust the code ..
In that case the code is even simpler ..

VBA Code:
Sub Combine_Sheets_v3()
  Dim ws As Worksheet
  
  For Each ws In Worksheets
    If ws.Name <> "Combined" Then ws.UsedRange.Offset(1).Copy Destination:=Sheets("Combined").Range("A" & Rows.Count).End(xlUp).Offset(1)
  Next ws
End Sub
 

unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
186
Office Version
  1. 2016
Platform
  1. Windows
tHANK YOU
In that case the code is even simpler ..

VBA Code:
Sub Combine_Sheets_v3()
  Dim ws As Worksheet
 
  For Each ws In Worksheets
    If ws.Name <> "Combined" Then ws.UsedRange.Offset(1).Copy Destination:=Sheets("Combined").Range("A" & Rows.Count).End(xlUp).Offset(1)
  Next ws
End Sub
Thank you!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,488
Office Version
  1. 365
Platform
  1. Windows
You are welcome. Thanks for the follow-up. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,129,511
Messages
5,636,759
Members
416,938
Latest member
sc58963

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