Copying The Chosen Numeric Values To The Other Sheet

Useful Macros - 12

Copying The Chosen Numeric Values To The Other Sheet

           In the previous examples, the columns that contain non-numeric values were copied .

We will copy the numerical values that comply with criteria in this template . 

There are numeric values in Column I. Now let's copy the great values from 20.000 in Column I to other sheet.

We can view number of the copied data on the opened msgbox.

VBA codes that we used to copy numeric values :

Sub run_transfer()
Dim i, k, a, filledr As Long, sh2 As Worksheet
Application.ScreenUpdating = False

Set sh2 = Sheets("Copied_Values")
a = Sheets("Data").Cells(Rows.Count, 1).End(xlUp).Row
last = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
filledr = WorksheetFunction.CountA(sh2.Range("A:A"))
For i = 1 To a
If VBA.Val(Cells(i, 9)) > 20000 Then
Sheets("Data").Rows(i).Copy sh2.Rows(last)
last = last + 1
End If
Next i
MsgBox "The copied record's number :" & " " & WorksheetFunction.CountA(sh2.Range("A:A")) - filledr
If WorksheetFunction.CountA(sh2.Range("A:A")) - filledr = 0 Then ' The number of data transferred are calculated
Exit Sub
Else

For k = 2 To ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
    sh2.Cells(k, 9).Font.ColorIndex = 3
Next

sh2.Range("A1:I1").Value = Sheets("Data").Range("A1:I1").Value  ' Column headings are set.
sh2.Columns("A:I").AutoFit                                     ' Column widths are set.

End If
Application.ScreenUpdating = True
i = Empty: k = Empty: a = Empty: filledr = Empty: Set sh2 = Nothing ' The variables are emptied to speed up the macro .
End Sub