How To Copy/Paste Partial Row - vba

Question

The following macro does everything it is designed for, EXCEPT the copy/paste portion. I am at a loss what correction/s to make.
The macro searches each sheet, specific column (either F or G), seeking any value greater than ZERO. If found, it should copy Cols B:F or B:G (depending on which column was searched) and paste those values to the appropriate worksheet.
Thank you for your assistance !
Option Explicit
Sub SampleCopy()
Dim ws As Worksheet
Dim c As Range
'On Error Resume Next
Application.ScreenUpdating = False
For Each ws In Worksheets
Select Case ws.Name
Case "In Stock", "To Order", "Sheet1"
'If it's one of these sheets, do nothing
Case Else
For Each c In Range("F15:F" & Cells(Rows.Count, 6).End(xlUp).Row)
If c.Value >= 1 Then
Range("B:G").Copy Sheets("In Stock").Cells(Rows.Count, 2).End(xlUp)(1) 'Edit sheet name
End If
Next c
For Each c In Range("G15:G50" & Cells(Rows.Count, 7).End(xlUp).Row)
If c.Value >= 1 Then
Range("B:G").Copy Sheets("To Order").Cells(Rows.Count, 2).End(xlUp)(1) 'Edit sheet name
End If
Next c
End Select
Next ws
Application.ScreenUpdating = True
End Sub
Download Example WB

Answer 1

Try this code. Pay attention to the explicit indication of the sheet ws.Range,ws.Cells and the need to fill in cells B14 on the sheets In Stock,To Order to correctly determine the last rows in the tables in case are they empty:
Option Explicit
Sub SampleCopy()
Dim ws As Worksheet
Dim c As Range, rngToCopy As Range
'On Error Resume Next
'Application.ScreenUpdating = False
For Each ws In Worksheets
Select Case ws.Name
Case "In Stock", "To Order", "Sheet1"
'If it's one of these sheets, do nothing
Case Else
For Each c In ws.Range("F15:F" & ws.Cells(Rows.Count, 6).End(xlUp).Row)
If c.Value > 0 Then
Set rngToCopy = Intersect(ws.Columns("B:G"), c.EntireRow)
If Not rngToCopy Is Nothing Then
rngToCopy.Copy Sheets("In Stock").Cells(Rows.Count, 2).End(xlUp)(2).Resize(, rngToCopy.Columns.Count) 'Edit sheet name
End If
End If
Next c
For Each c In ws.Range("G15:G" & ws.Cells(Rows.Count, 7).End(xlUp).Row)
If c.Value > 0 Then
Set rngToCopy = Intersect(ws.Columns("B:G"), c.EntireRow)
If Not rngToCopy Is Nothing Then
rngToCopy.Copy Sheets("To Order").Cells(Rows.Count, 2).End(xlUp)(2).Resize(, rngToCopy.Columns.Count) 'Edit sheet name
End If
End If
Next c
End Select
Next ws
Application.ScreenUpdating = True
End Sub