用于将数据粘贴到新表行中的 VBA 宏 - Excel

Question

我记录了一个宏，它试图从表格外部的单元格中复制信息，并将它们粘贴到同一张表的新行中。尝试运行宏时，我收到“运行时错误 '1004'：Range 类的 PasteSpecial 方法失败。”问题似乎在于第一行说明：

Selection.PasteSpecial 粘贴：=xlPasteValues，操作：=xlNone，SkipBlanks _ :=假，转置：=假

我在这个模块中有一组粘贴特殊代码，所以我担心第一行可能不是唯一的问题。以下是我到目前为止的代码。

Sub PlaceOrder()
'
' PlaceOrder Macro
'

'
    Range("A3").Select
    Selection.Copy
    Range("Table1[[#Headers],[Balance]]").Select
    Selection.End(xlDown).Select
    Selection.ListObject.ListRows.Add AlwaysInsert:=False
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range("B3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B23").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range("C3:E3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, 3).Range("A1").Select
    Range("F3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F23").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, 3).Range("A1").Select
    Range("E3").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("D3").Select
    Selection.ClearContents
    Range("C3").Select
    Selection.ClearContents
    Range("B3").Select
    Selection.ClearContents
    Selection.ConvertToLinkedDataType ServiceID:=268435456, LanguageCulture:= _
        "en-US"
End Sub

任何帮助将不胜感激！

编辑： Worksheet

附件是我正在使用的工作表的屏幕截图。我希望能够将 A3 和 C3-F3 的值以及 B3 中的公式粘贴到下表中。在粘贴所有这些信息之前，需要插入一个新行。

Answer 1

这应该可行。它基本上只是您代码的更清晰版本。

Sub PlaceOrder()

Dim tbl As ListObject
Dim LastRow As Long
Set tbl = ActiveSheet.ListObjects("Table1")
LastRow = tbl.Range.Rows.Count    'get # of last row

With ActiveSheet
    'copy and paste A3
    .Range("A3").Copy
    tbl.Range(LastRow, 1).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    'copy and paste B3
    .Range("B3").Copy
    tbl.Range(LastRow, 2).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
    
    'copy and paste C3:F3
    .Range("C3:F3").Copy
    tbl.Range(LastRow, 3).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    'clear value in B3:F3
    .Range("B3:F3").ClearContents
    
End With

End Sub

您的原始宏不起作用，因为系统在此行之后忘记了复制的值： Selection.ListObject.ListRows.Add AlwaysInsert:=False