VBA 将值粘贴到最后一行下方的新 sheet

Question

我想将一个 sheet 的行粘贴到另一个 sheet （在最后使用的行下方），如果一行的第 30 列中的单元格值等于 1。

我可以使用常规粘贴来执行此操作，但我一直无法粘贴值。每次编辑

Worksheets("ARF Data Table").Cells(b + 1, 1).Select
ActiveSheet.Paste

到

Worksheets("ARF Data Table").Cells(b + 1, 1).Select
ActiveSheet.PasteSpecial xlPasteValues

我收到错误

运行-时间错误'1004'： PasteSpecial 工作方法sheetclass失败。

我想我需要为粘贴特殊方法粘贴创建一个范围，但我不知道如何执行此操作，因为该范围从最后一行之后的行开始，上面有先前粘贴的数据。抱歉，如果已经有帖子对此进行了解释。

我使用的代码如下。

Sub MoveCopyRowsColumns()

a = Worksheets("ARF Form Working Data").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("ARF Form Working Data").Cells(i, 30).Value = 1 Then

Worksheets("ARF Form Working Data").Rows(i).Copy
Worksheets("ARF Data Table").Activate
b = Worksheets("ARF Data Table").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("ARF Data Table").Cells(b + 1, 1).Select
ActiveSheet.PasteSpecial xlPasteValues
Worksheets("ARF Form Working Data").Activate

End If
Next

Application.CutCopyMode = False

ThisWorkbook.Worksheets("ARF Form Working Data").Cells(b, 1).Select
End Sub

Answer 1

尝试直接价值转移。

option explicit

Sub MoveCopyRowsColumns()

    dim b as long

    with Worksheets("ARF Form Working Data")

        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row

            If .Cells(i, 30).Value = 1 Then
                with .range(.cells(i, "A"), .cells(i, .columns.count).end(xltoleft))
                    b = Worksheets("ARF Data Table").Cells(Rows.Count, 1).End(xlUp).Row
                    Worksheets("ARF Data Table").Cells(b + 1, 1).resize(.rows.count, .columns.count) = .value
                end with
            end if

        next i

    end with

End Sub

或Range.PasteSpecial xlPasteValues 到目标单元格，而不是父工作表。

option explicit

Sub MoveCopyRowsColumns()

    dim b as long

    with Worksheets("ARF Form Working Data")

        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row

            If .Cells(i, 30).Value = 1 Then
                b = Worksheets("ARF Data Table").Cells(Rows.Count, 1).End(xlUp).Row
                .range(.cells(i, "A"), .cells(i, .columns.count).end(xltoleft)).copy
                Worksheets("ARF Data Table").Cells(b + 1, "A").PasteSpecial paste:=xlPasteValues
                end with
            end if

        next i

    end with

End Sub

Answer 2

另一种方法是避免copy/paste的多次迭代。使用 Union 然后 copy/paste 构建您的复制范围。

Option Explicit

Sub MoveCopyRowsColumns()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("ARF Form Working Data")
Dim db As Worksheet: Set db = ThisWorkbook.Sheets("ARF Data Table")

Dim b As Long, i As Long
Dim CopyRange As Range

For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
    If ws.Cells(i, 30).Value = 1 Then
        Set CopyRange = Union(CopyRange, ws.Rows(i))
    End If
Next i

b = db.Cells(db.Rows.Count, 1).End(xlUp).Offset(1).Row
CopyRange.Copy: db.Cells(b, 1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

ws.Cells(b, 1).Select

End Sub

VBA 将值粘贴到最后一行下方的新 sheet

VBA Paste Value into new sheet below last row

excel

vba

copy-paste