Copy an array if a specific column has a numeric values - vba

Question

Hi I would like to create the code, where I could copy the values in a certain array and paste only the values of that array to the column in front.
The arrays to be copied are in multiple arrays and should be copied and pasted to a column in front but only if there are numerical values in column A.
This is how the arrays with values (in yellow) look before the copy:
And here is the outcome when they are pasted in the column in front (overwriting the rest):
My code is not working for many reasons and mainly I think there is the problem with my loops. The first loop should indicate that the copy will take place only on the rows where values in column A are numerical.
Sub Cop()
Application.ScreenUpdating = False
Set CopySheet = ThisWorkbook.Sheets("Sheet1")
Const ColStart As Integer = 4 'Table to start copying
Const NewColStart As Integer = 3 'Table to start pasting
Const ColEnd As Integer = 10 'Table ends for copying and pasting
Const ColumnNumeric As Integer = 1 'Column with numbers
Dim TargetRow As Long
Dim i As Long
Dim cell1 As Range
Dim cell2 As Range
TargetRow = 4 'Row where my table an column with numbers starts
With CopySheet
For Each cell1 In Range(.Cells(TargetRow, ColumnNumeric), .Cells(.Rows.Count, ColumnNumeric))
If IsNumeric(cell1) = True Then
'Numeric value found.
For Each cell2 In Range(.Cells(TargetRow,ColStart),.Cells(.Rows.Count, ColEnd))
cell2.Copy
.Range(.Cells(TargetRow, NewColStart), .Cells(.Rows.Count, ColEnd)).PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Next cell2
TargetRow = TargetRow + 1
Else
Exit Sub
End If
Next cell1
TargetRow = TargetRow + 1
End With
Can anybody give a hand on that? I was trying different loops but I am not sure how to finish them.

Answer 1

This Sub bellow
Iterates through each cell with data in column A (COL_NUMERIC)
If it contains a number (it doesn't contain an error and it's not empty)
Dynamically determines the last column with data on the current row
Copies the row with data (starting in Col D - COL_START) to an array
Clears the data from the row
Pastes the values from the array, one column to the left (it expects COL_START to be > 1)
Option Explicit
Public Sub MoveRowsLeft()
Const COL_NUMERIC = 1
Const ROW_START = 4
Const COL_START = 4
Dim ws As Worksheet, lr As Long, lc As Long
Dim nCol As Range, itm As Range, r As Long, arr As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, COL_NUMERIC).End(xlUp).Row
If lr > ROW_START Then
Application.ScreenUpdating = False
Set nCol = ws.Range(ws.Cells(ROW_START, COL_NUMERIC), ws.Cells(lr, COL_NUMERIC))
For Each itm In nCol
If Not IsError(itm) Then
If IsNumeric(itm) And Len(itm.Value2) > 0 Then
r = itm.Row
lc = ws.Cells(r, ws.Columns.Count).End(xlToLeft).Column
If lc > COL_NUMERIC Then
arr = ws.Range(ws.Cells(r, COL_START), ws.Cells(r, lc))
ws.Range(ws.Cells(r, COL_START), ws.Cells(r, lc)).ClearContents
ws.Range(ws.Cells(r, COL_START - 1), ws.Cells(r, lc - 1)) = arr
End If
End If
End If
Next
Application.ScreenUpdating = True
End If
End Sub