Consolidating Multiple Sheets into One - With one Exception!

[robman63]

Hello!

I have a Macro (listed below) which works PERFECTLY!

It takes multiple worksheets and joins all the data found across all the multiple sheets into 1 Worksheet called "Combined".

Unfortunately, I have 1 hidden worksheet called "lists" that I would prefer to keep out of the macro but it takes the information from there and uses it too. I do not want this.

-------------------

My question is: Is there a Statement or Expression I can add to this macro to prevent it from joining that particular sheet called lists?


Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A1000000").End(xlUp)(2)
Next
End Sub


Any help in this matter would be greatly appreciated! This is my first question on here! :O)

 

[Fluff]

HI, and welcome to the board.
Try this

Sub Combine()
    Dim J As Integer
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Combined"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
        If Not Sheets(J).Name = "lists" Then
            Sheets(J).Activate
            Range("A1").Select
            Selection.CurrentRegion.Select
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets(1).Range("A1000000").End(xlUp)(2)
        End If
    Next
End Sub

 

[robman63]

Hi Fluff! Thank you for the quick response! Your mod on the macro worked, but it also threw it out of whack. it is skipping part of what the original macro did. I'm not sure why.

HI, and welcome to the board.
Try this

Sub Combine()
    Dim J As Integer
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Combined"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
        If Not Sheets(J).Name = "lists" Then
            Sheets(J).Activate
            Range("A1").Select
            Selection.CurrentRegion.Select
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets(1).Range("A1000000").End(xlUp)(2)
        End If
    Next
End Sub

 

[Fluff]

What is it skipping?
All I did was add the if Statement.
That said, I would recommend removing this line

On Error Resume Next

As it simply masks any errors that may be occurring.

 

[robman63]

What is it skipping?
All I did was add the if Statement.
That said, I would recommend removing this line

On Error Resume Next

As it simply masks any errors that may be occurring.

Hi Fluff!

Sorry about that! It was my mistake. It is working perfectly!

The problem is that my "combine" macro is part of a larger macro which calls 6 macros, "combine" being one of them and I overlooked a step. But your fix did it! Thank you!

 

[Fluff]

Glad to help & thanks for the feedback