VBA Paste Value into new sheet below last row

2019-06-14 07:52发布

I want to paste the rows of one sheet into another sheet (below the last used row) if the cell value in column 30 of a row is equal to 1.

I can do this with a regular paste but I have been unable to paste values. Every time i edit

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

to

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

I get the error

Run-time error '1004': PasteSpecial Method of worksheet class failed.

I think I need to create a range for the paste special method to paste into, but I don't know how to do this as the range begins on the row after the last row with previously pasted data on it. Apologies if there is a thread already explaining this.

The code I'm using is below.

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

2条回答
forever°为你锁心
2楼-- · 2019-06-14 08:41

Try a direct value transfer.

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

Or Range.PasteSpecial xlPasteValues into the destination cell, not the parent worksheet.

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
查看更多
再贱就再见
3楼-- · 2019-06-14 08:55

Another method is to avoid many iterations of copy/paste. Build your copy range with a Union and then copy/paste that.

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
查看更多
登录 后发表回答