Looping through worksheets to copy/paste to new sheet - last sheet never copies

[lifeboat]

Hello all - I have a simple sub that creates a new sheet, then loops through all the remaining sheets to copy its data and paste it to the new sheet. For some reason, however, it never copies the last sheet. My code:

Sub CopyPasta()

Application.ScreenUpdating = False
Worksheets.Add(Before:=Worksheets(1)).Name = "Data Sheet"

Dim ws As Worksheet
         
   For Each ws In Worksheets
   
      If ws.Name <> "Data Sheet" Then
          Range("A2").Select
          Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy Destination:=Worksheets("Data Sheet").Range("A1048576").End(xlUp).Offset(1, 0)
          ws.Activate
      End If
   Next
   
Worksheets("Data Sheet").Activate
Rows("1").EntireRow.Delete
Range("A1").Select
Application.ScreenUpdating = True
                 
End Sub

I have tried using a variable counter, i.e. - For i = 1 to ActiveWorkbooks.Worksheets.Count - and I get the same results, it copies/pastes all but the last sheet.

This happens no matter how many sheets I try to copy. What's more, if I add one to the counter, i.e. - For i = 1 to ActiveWorkbooks.Worksheets.Count + 1 - it throws a "subscript out of range" error, yet it manages to copy all the sheets as needed. I can add an error handler to ignore the error, but I'd rather not leave it that way.

I know the loop is reaching all the sheets, but I cannot for the life of me figure out why it will not copy/paste that last sheet. What am I missing? Any ideas?

Thanks - jfp

[nilem]

maybe so

Sub CopyPasta()
Application.ScreenUpdating = False
Worksheets.Add(Before:=Worksheets(1)).Name = "Data Sheet"
Dim ws As Worksheet
With Worksheets("Data Sheet")
    For Each ws In Worksheets
        If ws.Name <> "Data Sheet" Then
            ws.Range(ws.[a2], ws.[a2].SpecialCells(xlLastCell)).Copy .Range("A1048576").End(xlUp).Offset(1, 0)
        End If
    Next
    .Rows("1").Delete
    .Activate
    .Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub

[lifeboat]

nilem - thank you very much. That works perfectly.

Out of curiosity, do you (or anyone else reading) know why the original code skipped the copy/paste option for the last sheet?

[tom1977]

hi look at this code I think it is what you need

Sub CopyPasta()

Application.ScreenUpdating = False
Worksheets.Add(Before:=Worksheets(1)).Name = "Data Sheet"

Dim ws As Worksheet
         
   For Each ws In Worksheets
   
      If ws.Name <> "Data Sheet" Then
          ws.Range("A2:" & ws.Cells.SpecialCells(xlLastCell).Address).Copy Destination:=Worksheets("Data Sheet").Range("A1048576").End(xlUp).Offset(1, 0)
         
      End If
   Next
   
Worksheets("Data Sheet").Rows("1").EntireRow.Delete
Range("A1").Select
Application.ScreenUpdating = True
                 
End Sub

[tom1977]

try to run your code in steps (pressing F8 and everything will be clear)

[lifeboat]

tom1977 - thank you as well; your code also worked as needed. Will look at it in steps as you suggest to see what I'm missing.

Thanks again.

[tom1977]

look also at this. This is Your code without any changes (I changed only places of two rows)

Sub CopyPasta()

Application.ScreenUpdating = False
Worksheets.Add(Before:=Worksheets(1)).Name = "Data Sheet"

Dim ws As Worksheet
         
   For Each ws In Worksheets
   
      If ws.Name <> "Data Sheet" Then
         
          ws.Activate
           Range("A2").Select
          Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Copy Destination:=Worksheets("Data Sheet").Range("A1048576").End(xlUp).Offset(1, 0)
          
      End If
   Next
   
Worksheets("Data Sheet").Activate
Rows("1").EntireRow.Delete
Range("A1").Select
Application.ScreenUpdating = True
                 
End Sub

and remember that you do not have to select or activate any objects to do something with them

[lifeboat]

Thanks again, Tom - I see that now with not needing to activate or select objects; I'm relatively new to this.