Loop Fail: Only running code on Last worksheet

[Amco88]

Hi,

I have a project where I need to copy select cell values from 200+ sheets into One sheet (Kind of like a report).

The cell numbers are the same across all worksheets,

I managed to get the copy portion to work but its only running it on one worksheet, for some reason its the last sheet.

Im completely new to VBA so bare with me. Below is what I am running:

Sub Macro8()
  Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim LastRow As Long
    Dim CopyRng As Range


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Delete the sheet "Report" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Report").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    'Add a worksheet with the name "Report"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Report"


    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then
            'selecting the next row in report
        
            'Find the last row with data on the DestSh
            LastRow = DestSh.Range("A1").SpecialCells(xlCellTypeLastCell).Rows
           
            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("A2:C2, BI2:BK2")


            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


            End If
    Next sh


End Sub

 

[steve the fish]

To find your last row you need .Row not .Rows then you actually need to use LastRow not Last as you have used.

 

[Amco88]

To find your last row you need .Row not .Rows then you actually need to use LastRow not Last as you have used.

Thanks for the quick response. Made the changes as stated but still only copying the cells from the last sheet as opposed to all sheets:

Sub Macro8()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim LastRow As Long
Dim CopyRng As Range


With Application
.ScreenUpdating = False
.EnableEvents = False
End With


'Delete the sheet "Report" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Report").Delete
On Error GoTo 0
Application.DisplayAlerts = True


'Add a worksheet with the name "Report"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Report"


'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then




'Find the last row with data on the DestSh
LastRow = DestSh.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Fill in the range that you want to copy
Set CopyRng = sh.Range("A2:C2, BI2:BK2")



'values or want to copy everything look at the example below this macro
CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End With


End If
Next sh


End Sub

 

[steve the fish]

You still havent changed Last to LastRow. Type option explicit right at the top of your module. It will point it out to you.

 

[steve the fish]

It will be looping but at each loop it pastes the data over the previously pasted data which is why you are only seeing the last sheets data.

 

[Amco88]

It will be looping but at each loop it pastes the data over the previously pasted data which is why you are only seeing the last sheets data.

Beautiful!! Totally worked that time! Thanks for your help. I've been working with this for hours, you are a life saver