Combining Multiple Worksheets into one new Worksheet VBA

OminousDark

New Member
Joined
Jul 23, 2014
Messages
14
Hello guys, I need some help.

I have imported worksheets from multiple workbooks into my master workbook, although now I need to be able to combine these all into a "Combined" Worksheet.

There are no headings, although will need this new worksheet to start on the second row, leaving a gap for headings to be added in later.

They should loop through one at a time grabbing the information from each worksheet, putting them into the new "combined" worksheet and then deleting the other worksheets.

Thanks for any help, I have no clue how to do this, have looked around for a good 30-45mins found lots but nothing that works quite how I need it.

p.s. There will be ONE sheet that will NOT be combined with the rest. It is called x1.
 

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
This is generic combine worksheets macro. It assume that that all your worksheet are laid out the same way.

It inserts a new worksheet call combined and then loops through all the other worksheets copying the data to the combined worksheets page (you will need to make sure that you don't already have a worksheet named "Combined" at the start.

I am not sure if this is exactly what you want as I wrote it in about ten minutes, but you should be able to modify it if you need to.

Code:
Option Explicit

Sub CombineWorksheets()

    Dim ws As Worksheet
    Set ws = Worksheets.Add(Before:=Worksheets(1))
    ws.Name = "Combined"
    
    Dim rng As Range, rng2 As Range
    Set rng = Worksheets(2).Range("A1").CurrentRegion
    rng.Copy ws.Range("A1")
    
    Dim i As Integer
    
    Dim wsCopy As Worksheet, rngCopy As Range, rngDest As Range
    
    For i = 3 To Worksheets.Count
        
        Set wsCopy = Worksheets(i)
        With wsCopy
            Set rngCopy = .Range("A1").CurrentRegion
            Set rngCopy = rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1)
        End With
            
        With ws
            Set rngDest = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
            
        rngCopy.Copy rngDest
        
    Next i

End Sub

Edit: After reading your post a bit more carefully, it is not exactly what you want. The macro copies the data on the first worksheet (to be copied) including the header row. For all the other worksheets it ignores the header row and just copies the data. I would spend more time on this, but I don't have time this afternoon. But you are almost there.
 
Last edited:
Upvote 0
This variation on the above deletes all worksheets at the end except for the "Combined" worksheet. Make sure you back up your data before testing this.

Code:
Sub CombineWorksheets()

    Dim ws As Worksheet
    Set ws = Worksheets.Add(Before:=Worksheets(1))
    ws.Name = "Combined"
    
    Application.DisplayAlerts = False
    Dim rng As Range, rng2 As Range
    Set rng = Worksheets(2).Range("A1").CurrentRegion
    rng.Copy ws.Range("A1")
    
    Dim i As Integer
    
    Dim wsCopy As Worksheet, rngCopy As Range, rngDest As Range
    
    For i = 3 To Worksheets.Count
        
        Set wsCopy = Worksheets(i)
        With wsCopy
            Set rngCopy = .Range("A1").CurrentRegion
            Set rngCopy = rngCopy.Offset(1, 0).Resize(rngCopy.Rows.Count - 1)
        End With
            
        With ws
            Set rngDest = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
            
        rngCopy.Copy rngDest
        
    Next i
    
    ' Delete original worksheets
    For Each ws In Worksheets
        If ws.Name <> "Combined" Then ws.Delete
    Next ws
    
End Sub
 
Upvote 0
Now if you data really does not have headers. And assuming that row 1 is blank, and is to be blank on the combined worksheet then a slight change to the macro should do the trick:

Code:
Option Explicit


Sub CombineWorksheets_NoHeaders()


    Dim ws As Worksheet
    Set ws = Worksheets.Add(Before:=Worksheets(1))
    ws.Name = "Combined"
    
    Application.DisplayAlerts = False
    Dim rng As Range, rng2 As Range
    Set rng = Worksheets(2).Range("A2").CurrentRegion
    rng.Copy ws.Range("A2")
    
    Dim i As Integer
    
    Dim wsCopy As Worksheet, rngCopy As Range, rngDest As Range
    
    For i = 3 To Worksheets.Count
        
        Set wsCopy = Worksheets(i)
        With wsCopy
            Set rngCopy = .Range("A2").CurrentRegion
        End With
            
        With ws
            Set rngDest = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
            
        rngCopy.Copy rngDest
        
    Next i
    
    ' Delete original worksheets
    For Each ws In Worksheets
        If ws.Name <> "Combined" Then ws.Delete
    Next ws
    
End Sub
 
Upvote 0
I think this final version does what you want. At the end this macro deletes all worksheets except "Combined" and "X1"

Code:
Sub CombineWorksheets_NoHeaders()


    Dim ws As Worksheet
    Set ws = Worksheets.Add(Before:=Worksheets(1))
    ws.Name = "Combined"
    
    Application.DisplayAlerts = False
    Dim rng As Range, rng2 As Range
    Set rng = Worksheets(2).Range("A2").CurrentRegion
    rng.Copy ws.Range("A2")
    
    Dim i As Integer
    
    Dim wsCopy As Worksheet, rngCopy As Range, rngDest As Range
    
    For i = 3 To Worksheets.Count
        If Worksheets(i).Name <> "X1" Then
        
            Set wsCopy = Worksheets(i)
            With wsCopy
                Set rngCopy = .Range("A2").CurrentRegion
            End With
                
            With ws
                Set rngDest = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
            End With
                
            rngCopy.Copy rngDest
        End If
        
    Next i
    


    For Each ws In Worksheets
        Select Case ws.Name
            Case "Combined"
            Case "X1"
            Case Else
                ws.Delete
        End Select
    Next ws


End Sub

I was forced to use that SELECT CASE construction at the end, because IF THEN ELSE was not working for me for some reason.

If anybody can see what was wrong with the code below please enlighten me.

Code:
    For Each ws In Worksheets


        If ws.Name <> "Combined" Or ws.Name <> "X1" Then
            Debug.Print ws.Name & " -- Delete"
        Else
            Debug.Print ws.Name & " -- Keep"
        End If
    Next ws

For some reason that little loop above deletes the Combined worksheet. Not sure why (its been a long day, I might not be thinking clearly).

BUT OP I think that latest version I have posted does everything that you want.

Edit:
Sorry I think this might be flawed. It assumes that the first worksheet (which will be worksheets(2) after the "Combined" worksheet is added) is not the "X1" worksheet.... and the thing is it might be. It's almost there you might just need to tweak it a bit.
 
Last edited:
Upvote 0
Power Query aka Gather & Transform is a great tool for gathering information
Power Query can do amazing things simply
The downside is it can be challenging to learn Power Query
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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