Combining Multiple Worksheets into one new Worksheet VBA

[OminousDark]

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.

 

[OminousDark]

-bump- - Sorry, still trying to figure this out, but cannot seem to find it.

 

[Harry Flashman]

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.

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.

 

[Harry Flashman]

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.

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

 

[Harry Flashman]

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:

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

 

[Harry Flashman]

I think this final version does what you want. At the end this macro deletes all worksheets except "Combined" and "X1"

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.

    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.

 

[garylhaas]

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