Question

我有一个范围，用作另一个宏的原始数据转储。在此范围内，我希望vba穿过某些列（列Q），当条件为1时，复制目标范围并移至表格底部。我不知道该表的vba，因此只需确定最后一行，在表的底部添加1即可粘贴，因为该表会自动调整大小。

我的代码完成了我需要做的一切，除了以下各项：它找到的每个实例都将其粘贴在底部...但是在循环时，它将覆盖在表格底部进行的最后一个输入，而不是查找新行和下面的粘贴。我尝试添加一个睡眠计时器，这是我能够看到它被覆盖但无法解决问题的方式。

数据转储范围： W到AC列值从第4行开始到数据转储的最后一行。列X-条件列，为0或1。如果为1，则需要移动数据。条件为= 1的X到AA列已从该区域移至表格。

表从头开始到A3，一直到第309行。如果我从数据转储中有5个条目，那么我希望这些值粘贴到表的下方，从C列开始。因此将行从309扩展到313。 / p>

Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)

Sub test1()
    Dim Cell As Range
    Dim lastrow As Long
    Dim TargtRng As Range

    With Sheets("Data_Rates")
        lastrow = Worksheets("Data_Rates").Cells(Rows.Count, "C").End(xlUp).Row + 1

        For Each Cell In .Range("X4:X" & .Cells(.Rows.Count, "X").End(xlUp).Row)
            If Cell.Value = "1" Then
                '.Range(Cell, Cell.Offset(, 3)).Copy Destination:=.Cells(lastrow, "C")
                Set TargtRng = .Range(Cell, Cell.Offset(, 3))
                .Range(Cells(lastrow, "C"), Cells(lastrow, "E")).Resize(TargtRng.Rows.Count, TargtRng.Columns.Count).Value = TargtRng.Cells.Value
                Sleep (500)
            End If
        Next Cell
    End With
End Sub

Answer 1

尝试一下，稍微简化一下，但最重要的是在循环中使用最后一行变量，以便在您复制更多数据时更新。

Sub test1()

Dim Cell As Range
Dim lastrow As Long
Dim TargtRng As Range

With Sheets("Data_Rates")
    For Each Cell In .Range("X4:X" & .Cells(.Rows.Count, "X").End(xlUp).Row)
        If Cell.Value = 1 Then
            lastrow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
            .Cells(lastrow, "C").Resize(, 4).Value = Cell.Resize(, 4).Value
        End If
    Next Cell
End With

End Sub

循环将值传输到范围的底部会错误地覆盖值

1 个答案: