Search code examples
excelvbaloopscopy-paste

Excel VBA copy and paste from multiple sheets, excluding certain sheets, depending on the value in a certain cell

Please go easy on me, I am new to this. I have a number of work sheets, and I have information populating into those sheets from other worksheets in the spreadsheet. I would like to summarise the sheets that have populated into one sheet for printing. The idea is to find any sheet with values past cell B10 (values not formulas) and copy the entire contents of the sheet, onto the last blank cell - offset by 1 (leaving a blank line in between) in the "Output" sheet. So far I am using "AHU Sheet 1", AHU Sheet 2" (both have populated values in B11 and below) and "AHU Sheet 3" which only has a formula in B11, this is a test sheet for empty information.

I want to exclude other sheets.

my code so far, which does nothing at all.

Please help :)

Sub printAll()

Dim ws As Worksheet
        For Each ws In Worksheets
        If ws.Name <> "Task Lists" And ws.Name <> "AHU-FCU Asset List" And ws.Name <> "Direct Expansion Asset List" And ws.Name <> "Refrigeration Asset List" And ws.Name <> "General Fans Asset List" And ws.Name <> "Lookups" And ws.Range("B10").Value <> "" Then

            ws.Cells.Copy

        Sheets("Output").Range("A" & Rows.Count).End(xlUp).Offset (1)
            .PasteSpecial Paste:=xlPasteValues
            .PasteSpecial Paste:=xlPasteFormats
        End If
    Next ws
 

End Sub

Edit after @IgorPokalev Help

 Sub printAll()

    Dim ws, wso As Worksheet, lastRow_ws, lastRow_wso As Long
    Set wso = Sheets("Output")
    
    For Each ws In Worksheets
        If ws.Name <> "Task Lists" And _
            ws.Name <> "AHU-FCU Asset List" And _
            ws.Name <> "Direct Expansion Asset List" And _
            ws.Name <> "Refrigeration Asset List" And _
            ws.Name <> "General Fans Asset List" And _
            ws.Name <> "Lookups" And _
            ws.Name <> "Output" And _
            ws.Range("B11").Value <> "" Then
            
            lastRow_ws = ws.Cells(Rows.Count, "B").End(xlUp).Row 'get last row of data based on column B in each ws
            lastRow_wso = wso.Cells(Rows.Count, "B").End(xlUp).Row 'get last row of data copied into the Output sheet based on column B
            ws.Rows("1:" & lastRow_ws).Copy _
                Destination:=wso.Range("A" & lastRow_wso + IIf(lastRow_wso > 1, 2, 0)) 'IIf(lastRow_wso > 1, 2, 0) adds a blank separator row
        End If
    Next
 
End Sub

This is A through H on one of the sheets, kind of messy when you see it here. If there are tasks from B10 down, I would like to copy it to "Output", formatted the same way it is input. The tasks are imported via a formula. I hope this is helpful. Rows 1 through 5 are the header information with the equipment details.
A=Empty B= Tasks:
Inspect and clean outdoor air intakes and exhaust air discharges where necessary.
etc. Formatting Full sheet

Output

Solution

  • See if this works for you:

    Sub printAll()

    Dim ws, wso As Worksheet, lastRow_ws, lastRow_wso As Long
    Set wso = Sheets("Output")
    
    For Each ws In Worksheets
        If ws.Name <> "Task Lists" And _
            ws.Name <> "AHU-FCU Asset List" And _
            ws.Name <> "Direct Expansion Asset List" And _
            ws.Name <> "Refrigeration Asset List" And _
            ws.Name <> "General Fans Asset List" And _
            ws.Name <> "Lookups" And _
            ws.Range("B11").value <> "" And _
            Not (ws.Range("B11").HasFormula) Then 'check if "B11" is a formula
            
            lastRow_ws = ws.Cells(Rows.Count, "B").End(xlUp).row 'get last row of data based on column B in each ws
            lastRow_wso = wso.Cells(Rows.Count, "B").End(xlUp).row 'get last row of data copied into the Output sheet based on column B
            ws.Rows("1:" & lastRow_ws).Copy _
                Destination:=wso.Range("A" & lastRow_wso + IIf(lastRow_wso > 1, 2, 0)) 'IIf(lastRow_wso > 1, 2, 0) adds a blank separator row
        End If
    Next
 
End Sub

    This code copies rows 1 to last row based on column B data from each of the worksheets that meet your criteria. I'm not sure what your data looks like and if column B would have the true last row though.

    Output

    [Edit]

    See if this works:

    Sub printAll()
    Dim ws, wso As Worksheet, lastRow_ws, lastRow_wso As Long
    Set wso = Sheets("Output")
    
    For Each ws In Worksheets
        If ws.Name <> "Task Lists" And _
            ws.Name <> "AHU-FCU Asset List" And _
            ws.Name <> "Direct Expansion Asset List" And _
            ws.Name <> "Refrigeration Asset List" And _
            ws.Name <> "General Fans Asset List" And _
            ws.Name <> "Lookups" And _
            ws.Range("B11").value <> "" Then 'the 'Tasks:' list begins on B7 in your screenprint, change the range from B11 to B7 here if you'd like.
            
            lastRow_ws = ws.Cells(Rows.Count, "B").End(xlUp).row 'get last row of data based on column B in each ws
            lastRow_wso = wso.Cells(Rows.Count, "B").End(xlUp).row 'get last row of data copied into the Output sheet based on column B
            ws.Rows("1:" & lastRow_ws).Copy
            wso.Range("A" & lastRow_wso + IIf(lastRow_wso > 1, 2, 0)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            wso.Range("A" & lastRow_wso + IIf(lastRow_wso > 1, 2, 0)).PasteSpecial Paste:=xlPasteValues
'            wso.Range("A" & lastRow_wso + IIf(lastRow_wso > 1, 2, 0)).PasteSpecial Paste:=xlPasteFormats
        End If
    Next
End Sub

    The tasks list seems to start on B7. I added a comment in the code where you can change the last If condition to look at B7 instead of B11, depending on your needs.