Copy range of data from multiple worksheets based on numerical criteria

[CampbellSoup]

I have been playing with this code for a few days now. I have a spreadsheet that has about 10 tabs. Only 4 of the tabs I need to use for this code.

I created a master sheet called "Quickbooks" to make uploading materials into QB easier for the team and save hours a week for the production staff.

- They are all 4 formatted the same. "Data Take-Off", "Security Take-Off", "Electrical Take-Off", "AV Map Take-Off". We just use a different worksheet for each department to keep them separated during estimating.
- Column D is where the number will be at for the unit amounts.
-Range C-H of that particular row is what I need to copy to the "Quickbooks" sheets if a number is populated in D. "Next available row"
-I also need to be able to do this across all 4 worksheets simultaneously so I can keep the formatting of the "Quickbooks" sheet intact as shown below, unless there is an easier way to "rinse and repeat". This being because sometimes we go in and update quantities on these sheets last minute and will need to update the master sheet with the new quantities and not duplicate line items for quickbooks purposes.

Here is the basic code I got to work on a dummy spreadsheet when only dealing with one sheet at a time. I just can't seem to figure out how to call on multiple worksheets at the same time with the same commands "IF"/"THEN".

Sub qbcopy()

Dim i, lastrow

lastrow = Sheets("Data Take-Off").Range("D" & Rows.Count).End(xlUp).Row
Sheets("Quickbooks").Range("A2:I1500").ClearContents
Sheets("Quickbooks").Range("A2:I1500").ClearFormats
For i = 30 To lastrow
If Sheets("Data Take-Off").Cells(i, "D").Value > 0 Then
Sheets("Data Take-Off").Range(Cells(i, "C"), Cells(i, "H")).Copy
Destination:=Sheets("Quickbooks").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub

 

[JLGWhiz]

Just noticed a glitch in Post #10 , this will fix it.

Sub QBcopy()
Dim ary As Variant, i As Long, rng As Range, strt As Range, lr As Long
ary = Array("Data Take-Off", "Security Take-Off", "Electrical Take-Off", "AV Map Take-Off")
Sheets("QuickBooks").UsedRange.Offset(1).ClearContents
Sheets("Quickbooks").Range("A2:I1500").ClearContents
Sheets("Quickbooks").Range("A2:I1500").ClearFormats
    For i = LBound(ary) To UBound(ary)
        With Sheets(ary(i))
             lr = .Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
            If .Cells(25, "D") = "" Then
                Set strt = .Cells(25, "D").End(xlDown).Offset(, -1)
            Else
                Set strt = .Cells(25, "C")
            End If
            Set rng = .Range(strt, "H" & lr)
            rng.AutoFilter 2, ">0"
            If Application.CountA(rng.SpecialCells(xlCellTypeVisible)) > 0 Then
                rng.SpecialCells(xlCellTypeVisible).Copy _
                Sheets("QuickBooks").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End If
            .AutoFilterMode = False
        End With
    Next
End Sub

 

[CampbellSoup]

This is excellent and works great. Now how would I bring in the next column to the left? I've tried modifying the "-1" to "-2" but it doesn't seem to quite work like that. They added a new column to the left of the conditional column on me right when we were able to get it working properly. BUT, this works great as it is. I'm sure I can tinker with it to get it working.