Excel VBA - Selection Cut Paste Error

Question

I am creating a macro but I am stuck at this cut paste statement and not able to proceed since yesterday.

Here is the problem: I am selecting all the rows in column "D2 to F2" and pasting it at "A1". Here is the code for it :

Range("D2:F2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut

Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste    

Getting this Error:

Here's what I have tried :

1. Code Change: Using PasteSpecial instead of simple Paste .

    Range("D2:F2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Select 'ActiveSheet.Paste ' insted of this using paste special. ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

Getting the following error:

2. Code Change: Resized the selection to 3 columns.

    Range("D2:F2").Select Range(Selection, Selection.End(xlDown)).Select Selection.Cut Range("A1").Select Selection.End(xlDown).Select ActiveCell.Offset(1, 0).Resize(1, 3).Select 'ActiveSheet.Paste 

Getting this error:

3. Tried On Error Resume Next statement. It is ignoring the error message but not pasting the data as well.

---

I am looking for a way to ignore this error message and proceed with paste. We normally get this error when we manually copy-paste or cut-paste in excel sheet, there we have option to ignore and paste data. Similarly is there any method to ignore it within a macro?

Answer 1

Avoid Select at all costs . Try something like this instead

Sub foo()
Dim rng
Set rng = Range("D2:F" & GetLastRow(4))

rng.Cut
Application.Goto Range("A1").Offset(GetLastRow(1))
ActiveSheet.Paste

End Sub

Function GetLastRow(col As Long)
' modified from:
' https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba

If Application.WorksheetFunction.CountA(Columns(col)) <> 0 Then
    GetLastRow = Columns(col).Find(What:="*", _
                  After:=Cells(Rows.Count, col), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Row
Else
    GetLastRow = 1
End If

End Function

Answer 2

As mentioned in other answers and comments avoid the use of .Select at all costs. It is the source of many common errors. The next solution finds the last row with data by using a simple function.

Option Explicit

Function lastrow(rng_str As String)

    ' Adapted from http://www.rondebruin.nl/win/s9/win005.htm
    Dim rng As Range: Set rng = Range(rng_str)
    Dim r As Range
    lastrow = rng.Column

    With ActiveSheet
        For Each r In rng.Columns
            lastrow = Application.Max(lastrow, .Cells(.Rows.Count, r.Column).End(xlUp).Row)
        Next
    End With

End Function

Sub test()

    Dim source_rng As Range
    Dim dest_rng As Range
    Dim nr_rows As Long

    ' Maximum number of rows from D to F
    nr_rows = lastrow("D2:F2")

    Set source_rng = Range("D2:F" & nr_rows)
    Set dest_rng = Range("A1")

    source_rng.Cut
    dest_rng.Activate
    ActiveSheet.Paste

End Sub

HTH ;)

Answer 3

The problem is that you are trying to select a cell, which is one cell below the end of the table. After the stop, you have an offset, which gives you one cell lower. Check this out:

Option Explicit
Sub test()
    Range("D2:F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut

    Range("A1").Select
    Selection.End(xlDown).Select

    Debug.Print ActiveCell.Address
    Stop

    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste

End Sub

And, as already said, try to avoid select.