Copying worksheets into one

Hi mollysnuffy
What do you have so far

This is what I have so far but cant seem to get it to only look at column A where the value is 1. The code also seem quite long winded to the other examples I have found on the net but it kind of works (also haven't changed the sheet to be "Summary"). It is several few year since I dabbled with VB and other programming so I'm not 100% sure what does what, although some of what I was taught is making sense! Would appreciate any help.

Thank you.

This is how I would do that. It's a worksheet_activate macro, so each time you pull up the SUMMARY sheet, it will re-gather the data from the other sheets so it's always accurate.

Option Explicit

Private Sub Worksheet_Activate()
Dim ws As Worksheet, LR As Long, NR As Long
Application.ScreenUpdating = False

Range("A10:AA" & Rows.Count).Clear      'clears existing data from row 10 down
NR = 10

For Each ws In Worksheets
    ws.Range("A:A").AutoFilter Field:=1, Criteria1:="1"
    LR = ws.Range("A" & Rows.Count).End(xlUp).Row
    If LR > 1 Then
        ws.Range("A2:AA" & LR).SpecialCells(xlCellTypeVisible).Copy Range("A" & NR)
        NR = Range("A" & Rows.Count).End(xlUp).Row + 1
    End If
    ws.AutoFilterMode = False
Next ws
 
Application.ScreenUpdating = True
End Sub

This macro is installed into the sheet module.

1) You would have to go to the other sheets to change the values and come back, so SUMMARY sheet will always be accurate within the workbook itself.

2) This macro can replace the one in the workbook to fix the event to only the sheets named:

Option Explicit

Private Sub Worksheet_Activate()
Dim ws As Worksheet, LR As Long, NR As Long
Application.ScreenUpdating = False

Range("A10:AA" & Rows.Count).Clear      'clears existing data from row 10 down
NR = 10

For Each ws In Worksheets
    Select Case ws.Name
        Case "Bathroom", "Plumbing", "Tiling", "Plastering", "Labour-Sundries"
            ws.Range("A:A").AutoFilter Field:=1, Criteria1:="1"
            LR = ws.Range("A" & Rows.Count).End(xlUp).Row
            If LR > 1 Then
                ws.Range("A2:AA" & LR).SpecialCells(xlCellTypeVisible).Copy Range("A" & NR)
                NR = Range("A" & Rows.Count).End(xlUp).Row + 1
            End If
            ws.AutoFilterMode = False
    End Select
Next ws

Application.ScreenUpdating = True
End Sub

1) Right-click on the SUMMARY sheet tab
2) Select VIEW CODE
3) Delete the code in the window that appears
4) Paste in the code given above
5) Close the editor and save your workbook.

My pleasure.

If that takes care of your need, be sure to EDIT your original post, click Go Advanced and mark the PREFIX box [SOLVED].


(Also, use the blue "scales" icon in our posts to leave Reputation Feedback, it is appreciated. It is found across from the "time" in each of our posts.)