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

Posted 2023-03-27

【中文标题】用于将数据粘贴到新表行中的 VBA 宏 - Excel

【英文标题】：VBA Macro for Pasting Data In New Row of Table - Excel

【发布时间】：2021-09-05 08:50:42

【问题描述】：

我记录了一个宏，它试图从表格外部的单元格中复制信息，并将它们粘贴到同一张表的新行中。尝试运行宏时，我收到“运行时错误 '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 中的公式粘贴到下表中。在粘贴所有这些信息之前，需要插入一个新行。

【问题讨论】：

您能分享一下初始工作表和生成的（所需）工作表的屏幕截图吗？

感谢您回复我的问题。我添加了我的工作表的屏幕截图，并为我想要完成的工作提供了更多背景信息。

【参考方案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

【讨论】：

太棒了。这完美地工作了 Aster Hu。谢谢。

@isinkzat 因为你是新来的，please see this

完美，Aster Hu。谢谢你。现在我的电子表格遇到了另一个问题。我有两个简单的 WorkSheet_Calculate subs 写成几张纸。当另一个工作表上的单元格 >= 某个百分比时，表格 A 到 F 列中最后一行的内容将被清除。所以现在我遇到了问题，您提供的成功代码被粘贴到刚刚清除内容的行下方的新行中。有没有办法修改您提供的代码，以便可以将信息复制并粘贴到由于我的其他代码的结果而留空的行中？

@isinkzat 如果我做对了，您想在添加新行后重新触发其他工作表中的 Worksheet_Calculate 事件，对吗？如果是这样，请在最后添加Application.CalculateFull，这将强制计算您的其他电子表格