Hello,
Thanks in advance to whoever may have an idea. I have found some code on here that I was trying to modify for my spreadsheet to do something similar. I do not know code very well at all as a heads up.
Basically I have a source work sheet called "Worksheet" and a destination worksheet called "BOM". If the QTY(located in row c) in the source worksheet is greater than 0 I want it to copy those specific rows and particular cells to the BOM worksheet when I click the button.
This does copy the correct cells, but it copies all rows even if it doesnt have any QTY at all.
Any thoughts?
Sub Button1_Click()
Dim sws As Worksheet, dws As Worksheet
Dim slr As Long, dlr As Long
Set sws = Sheets("Worksheet")
Set dws = Sheets("BOM")
slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
dlr = dws.Cells(Rows.Count, 2).End(xlUp).Row
If dlr > 2 Then dws.Range("A3:G" & dlr).EntireRow.Clear
sws.AutoFilterMode = False
With sws.Rows(26)
.AutoFilter field:=3, Criteria1:=">0"
End With
sws.Range("C26:C340" & slr).SpecialCells(xlCellTypeVisible).Copy dws.Range("A3")
sws.Range("D26:D340" & slr).SpecialCells(xlCellTypeVisible).Copy dws.Range("B3")
sws.Range("E26:E340" & slr).SpecialCells(xlCellTypeVisible).Copy dws.Range("C3")
sws.Range("F26:F340" & slr).SpecialCells(xlCellTypeVisible).Copy dws.Range("D3")
sws.Range("G26:G340" & slr).SpecialCells(xlCellTypeVisible).Copy dws.Range("E3")
sws.AutoFilterMode = False
dws.Columns("C").AutoFit
MsgBox "Finished.", vbInformation
End Sub
Bookmarks