Speed up and simplify - excel

Question

I cobbled together something that does work for me as is, but it runs very slowly and I'm sure the code can be simplified.
Sub CopyPasteValues()
Dim strSht1, strSht2 As String
Dim c, rng As Range
strSht1 = "Edit"
strSht2 = "LOB"
With ThisWorkbook.Sheets(strSht1)
Set rng = Range("J2:AJ37")
For Each c In rng
If Not c.Value = 0 Then
Cells(c.Row, 2).Copy
ThisWorkbook.Sheets(strSht2).Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Range(Cells(c.Row, 4), Cells(c.Row, 5)).Copy
ThisWorkbook.Sheets(strSht2).Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
c.Copy
ThisWorkbook.Sheets(strSht2).Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Cells(c.Column).Copy
ThisWorkbook.Sheets(strSht2).Range("G" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
Next c
End With
End Sub
I appreciate any assistance.

Answer 1

As BigBen Mentioned, array method.
Super Fast.
Sub Move_Values_Array_Method()
Dim SourceSheet As Worksheet 'Source Worksheet
Dim DestinationSheet As Worksheet 'Destination Worksheet
Dim RG As Range 'Source Range
Dim InArr() 'Data In Array
Dim OutArr() 'Data Out Array
Dim X As Long 'Array X Position for purposes of iterating through array.
Dim Y As Long 'Array Y Position for purposes of iterating through array.
Dim Cnt As Long 'Found Value Count
Set SourceSheet = ThisWorkbook.Worksheets("Edit") 'Set Source Worksheet
Set DestinationSheet = ThisWorkbook.Worksheets("LOB") 'Set Dest Worksheet
Set RG = SourceSheet.Range("J2:AJ37") 'Set Source Range
ReDim OutArr(1 To RG.Cells.Count) 'Count Cells in Range, resize output array to be at least that big.
InArr = RG 'Transfer Range Data to Array
Cnt = 0
Debug.Print LBound(InArr, 1) & " - " & UBound(InArr, 1) 'Rows
Debug.Print LBound(InArr, 2) & " - " & UBound(InArr, 2) 'Columns
For Y = 1 To UBound(InArr, 1) 'For Each Row in Array (or each Y position)
For X = 1 To UBound(InArr, 2) 'For Each Column in Array (or each X position)
If InArr(Y, X) <> "" Then 'If not blank Value (you can change this to "If InArr(Y, X) <> 0 Then" if that works best for you.
Cnt = Cnt + 1 'Increment "found value count" by 1
OutArr(Cnt) = InArr(Y, X) 'Add found value to output array
End If
Next X
Next Y
'Output to Dest Sheet
DestinationSheet.Range("F2").Resize(UBound(OutArr, 1), 1).Value = Application.Transpose(OutArr())
End Sub

Answer 2

Based on the information in your previous comments, try these alternative solution using formulas and filters...
1) Array Formulas
To note:
I have put everything on one sheet for clarity, but it works just as well over multiple sheets, or even workbooks.
If you want to filter the entire sheet, with same column order, you only need to enter formula once and expand "Array" criteria in formula to encapsulate entire data set.
Formula used in cell "J4" = "=FILTER($I$4:$I$30,$C$4:$C$30>0)"
(filter range I4 to I30 to show rows where value in range C4 to C30 is greater than 0)
2) Directly Filter
Alternatively, you could (either manually or programmatically) copy all data to LOB sheet, (or selectively copy), then filter for Qty>0.