Paste method of worksheet class in a loop

Question

I tried to select and copy from Sheet 4 to Sheet 5 till the end of the list on Sheet 4.

It works one time only, not looping, and giving me an error message

"pasteSpecial method of worksheet class failed"

Code:

Sub SelectBetween()

i = 1

Sheets("Sheet4").Activate

Do Until i > 63

    Dim findrow As Long, findrow2 As Long

    findrow = Range("A:A").Find("Department", Range("A1")).Row
    findrow2 = Range("A2:A3141").Find("Department", Range("A" & findrow)).Row
    Range("A" & findrow & ":A" & findrow2 - 1).Select

    Selection.Cut Sheets("Sheet5").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)

    ActiveSheet.PasteSpecial Link:=True
    Application.CutCopyMode = False

    i = i + 1

Loop

End Sub

score 0 · Answer 1 · answered Dec 18 '19 at 12:14

Try this.

Learn to avoid Select/Activate.

When using Find check the item is found before trying to access properties such as Row to avoid errors. And good practice to specify all its parameters.

You can use a For loop here as you know the endpoint.

Sub SelectBetween()

Dim i As Long

For i = 1 To 63
    Dim findrow As Range, findrow2 As Range
    With Sheets("Sheet4")
        Set findrow = .Range("A:A").Find(what:="Department",after:=.Range("A1"))
        If Not findrow Is Nothing Then
            Set findrow2 = .Range("A2:A3141").Find(what:="Department", after:=findrow)
            If Not findrow2 Is Nothing Then
                .Range(findrow, findrow2.Offset(-1)).Cut
                Sheets("Sheet5").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1).PasteSpecial Link:=True
            End If
        End If
    End With
Next i

End Sub

shouldn't you declare `findrow`and `findrow2` outside of the loop? — MGP, Dec 18 '19 at 13:39
@MG92 - makes no difference, they are not executable statements. — SJR, Dec 18 '19 at 15:42

score 0 · Answer 2 · answered Dec 18 '19 at 13:51

It worked well by the below code. only deleted the below lines from the previous code.

ActiveSheet.PasteSpecial Link:=True Application.CutCopyMode = False

Sub SelectBetween()

i = 1

Sheets("Sheet4").Activate

Do Until i > 63


    Dim findrow As Long, findrow2 As Long


    findrow = Range("A:A").Find("Department", Range("A1")).Row
    findrow2 = Range("A2:A3141").Find("Department", Range("A" & findrow)).Row
    Range("A" & findrow & ":A" & findrow2 - 1).Select

    Selection.Cut Sheets("Sheet5").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)


     i = i + 1

    Loop

End Sub

Paste method of worksheet class in a loop

2 Answers2