Скопируйте массив, если определенный столбец имеет числовые значения

Question

Здравствуйте, я хотел бы создать код, в котором я мог бы скопировать значения в определенном массиве и вставить только значения этого массива в столбец перед. Копируемые массивы находятся в нескольких массивах и должны копироваться и вставляться в передний столбец, но только если в столбце A имеются числовые значения.

Вот так выглядят массивы со значениями (желтым) перед копией:

И вот результат, когда они вставляются в столбец впереди (перезаписывая остальные):

Мой код не работает по многим причинам, и в основном я думаю, что есть проблема с моими циклами. Первый цикл должен указывать, что копирование будет иметь место только в строках, где значения в столбце A являются числовыми.

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

Кто-нибудь может помочь? Я пробовал разные циклы, но я не уверен, как их закончить.

Answer 1

Это Sub ниже

• Итерация по каждой ячейке с данными в столбце A (COL_NUMERIC)
• Если оно содержит число (оно не содержит ошибки и оно не пустое)
• Динамически определяет последний столбец с данными в текущей строке
• Копирует строку с данными (начиная с Col D - COL_START) в массив
• Удаляет данные из строки
• Вставляет значения из массива, один столбец слева (ожидается, что COL_START будет> 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