Question

如果某行的第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方法失败。

我想我需要为粘贴特殊方法创建一个范围以粘贴到其中，但是我不知道如何执行此操作，因为该范围从最后一行之后的行开始，并带有先前粘贴的数据。抱歉，如果已经有一个线程对此进行解释。

我正在使用的代码如下。

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

另一种方法是避免多次复制/粘贴。使用Union建立复制范围，然后复制/粘贴该范围。

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将值粘贴到最后一行下方的新表中

2 个答案: