VBA to Combine Multiple Sheets Together

Henry1

New Member
Joined
Oct 23, 2017
Messages
15
Hi,
I have a workbook that has many tabs. Tabs are named the by Artists. I want to combine all the tabs into a master tab and create a new column in column A and drop in the artist name (the tab name). Can you please let me know what is the VBA code for this ?

Here are the steps by doing it manually,
Create a Consolidated Tabs
Create the headers Artist, Product ID, Product, Variation ID, Variation, Amount Remaining
Copy data from each tab and paste in cell B2
Add the tab name to column A.

Thanks!

1608055114526.png
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Henry1

New Member
Joined
Oct 23, 2017
Messages
15
This VBA does job but it needs to be modified to add Artist column and add the artist names based on the tab names. if someone can modify it would be great.

VBA Code:
Sub Combine()
Dim J As Integer
Dim s As Worksheet

On Error Resume Next
Sheets(1).Select
Worksheets.Add ' add a sheet in first place
Sheets(1).Name = "Combined"

' copy headings
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

For Each s In ActiveWorkbook.Sheets
If s.Name <> "Combined" Then
Application.GoTo Sheets(s.Name).[a1]
Selection.CurrentRegion.Select
' Don't copy the headings
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets("Combined"). _
Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next
End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,284
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Sub Henry()
   Dim i As Long
   Dim ws As Worksheet
   
   Set ws = Sheets.Add(Sheets(1))
   ws.Name = "Consolidated"
   ws.Range("A1").Value = "Artist"
   With Sheets(2).Range("A1").CurrentRegion
      .Copy ws.Range("B1")
      ws.Range("A2").Resize(.Rows.Count - 1).Value = Sheets(1).Name
   End With
   For i = 3 To Sheets.Count
      With Sheets(i).Range("A1").CurrentRegion
         .Offset(1).Copy ws.Range("B" & Rows.Count).End(xlUp).Offset(1)
         ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Rows.Count - 1).Value = .Parent.Name
      End With
   Next i
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,238
Try:
VBA Code:
Sub CombineSheets()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, desWS As Worksheet
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Not Evaluate("isref('" & "Consolidated" & "'!A1)") Then
        Sheets.Add(before:=Sheets(1)).Name = "Consolidated"
        Range("A1").Resize(, 6) = Array("Artist", "Product ID", "Product", "Variation ID", "Variation", "Amount Remaining")
        Columns.AutoFit
    Else
        Sheets("Consolidated").UsedRange.Offset(1).ClearContents
    End If
    Set desWS = Sheets("Consolidated")
    For Each ws In Sheets
        If ws.Name <> "Consolidated" Then
            With ws
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Range("A2:F" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1)
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(LastRow - 1) = ws.Name
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Solution

Henry1

New Member
Joined
Oct 23, 2017
Messages
15

ADVERTISEMENT

Try:
VBA Code:
Sub CombineSheets()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, desWS As Worksheet
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    If Not Evaluate("isref('" & "Consolidated" & "'!A1)") Then
        Sheets.Add(before:=Sheets(1)).Name = "Consolidated"
        Range("A1").Resize(, 6) = Array("Artist", "Product ID", "Product", "Variation ID", "Variation", "Amount Remaining")
        Columns.AutoFit
    Else
        Sheets("Consolidated").UsedRange.Offset(1).ClearContents
    End If
    Set desWS = Sheets("Consolidated")
    For Each ws In Sheets
        If ws.Name <> "Consolidated" Then
            With ws
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                .Range("A2:F" & LastRow).Copy desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1)
                desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1).Resize(LastRow - 1) = ws.Name
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub
Thank you. This is exactly what I needed.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,284
Office Version
  1. 365
Platform
  1. Windows
@Henry1
When you "Mark as solution" you are meant to select the post that helped you the most, not your post saying it worked. ;)
I have changed it for you.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,073
Messages
5,622,519
Members
415,905
Latest member
8765309

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