VBA to Combine Multiple Sheets Together

[Henry1]

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!

 

[Henry1]

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]

How about

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]

Try:

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

 

[Henry1]

Try:

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.

 

[mumps]

You are very welcome. Glad we could help.

 

[Fluff]

@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.