Copy Cells Greater than Zero, and Paste Values in same Cell - excel

Question

I have a table that is filled with formulas tied to another sheet. These formulas grab data from the other table based on whether the date at the top of the column matches the date in a single cell (Week Ending Date). I want to be able to automatically copy only the cells with a value greater than 0, and then paste them back into the same cell as a value. I used the following formula to try and accomplish this, but it didn't quite do what I wanted it to. Be gentle, I'm a novice at best.
Sub CopyC()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("Table4")
For Each cel In SrchRng
If cel.Value > 0 Then
cel.Copy
cel.PasteSpecial xlPasteValues
End If
Next cel
End Sub
Expected Output: Copy only Cells in my table that are greater than 0 and paste as value.
Goal: Preserve Formulas in cells that are blank
Results from above: Very slowly progressed cell by cell and copied and pasted in all cells, including blanks and 0 values, until it was stopped

Answer 1

Give this a try:
Sub CopyC()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("Table4")
For Each cel In SrchRng
If IsNumeric(cel.Value) And cel.Value > 0 Then
cel.Value = cel.Value
End If
Next cel
End Sub
EDIT: add an alternative using an array to loop through the data, this should be a bit faster:
Sub CopyC()
Dim SrchRng As Range: Set SrchRng = Range("Table4")
Dim arrSearch As Variant: arrSearch = SrchRng
Dim fRow As Long: fRow = SrchRng.Cells(1, 1).Row - 1
Dim fCol As Long: fCol = SrchRng.Cells(1, 1).Column - 1
Dim R As Long, C As Long
For R = LBound(arrSearch) To UBound(arrSearch)
For C = LBound(arrSearch, 2) To UBound(arrSearch, 2)
If IsNumeric(arrSearch(R, C)) And arrSearch(R, C) > 0 Then Cells(R + fRow, C + fCol).Value = arrSearch(R, C)
Next C
Next R
End Sub