Excel VBA - 选择剪切粘贴错误

Question

我正在创建一个宏，但我一直卡在这个剪切粘贴语句中，从昨天开始就无法继续了。

问题出在这里：我正在选择列 "D2 to F2" 中的所有行并将其粘贴到 "A1"。这是它的代码：

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

出现此错误：

这是我尝试过的方法：

代码更改：使用 PasteSpecial 而不是简单的 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

出现以下错误：

代码更改：将选择的大小调整为 3 列。

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

出现此错误：

尝试了 On Error Resume Next 语句。它忽略了错误消息，但也没有粘贴数据。

我正在寻找忽略此错误消息并继续粘贴的方法。我们通常在 excel sheet 中手动 copy-paste 或 cut-paste 时遇到此错误，我们可以选择忽略和粘贴数据。同样有什么方法可以在宏中忽略它吗？

Answer 1

Avoid Select at all costs。试试这样的方法

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:
' 

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

问题是您正在尝试 select 一个单元格，该单元格位于 table 末尾下方的一个单元格。停止后，您有一个偏移量，它使您降低一个单元格。看看这个：

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

并且，如前所述，尽量避免 select。

Answer 3

如其他答案和评论中所述，不惜一切代价避免使用 .Select。它是许多常见错误的根源。下一个解决方案使用一个简单的函数找到最后一行数据。

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 ;)

Excel VBA - 选择剪切粘贴错误

Excel VBA - Selection Cut Paste Error

excel

vba

copy-paste