Issue with Copying from one sheet to another

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

Calling it Worksheet is a bad idea - but:

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

Maybe:

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:="<>"
End With
sws.Range("C26:G340" & slr).SpecialCells(xlCellTypeVisible).Copy dws.Range("A3")

sws.AutoFilterMode = False
dws.Columns("C").AutoFit
MsgBox "Finished.", vbInformation
End Sub