VBA: 正在将数据复制到现有列表对象中

Question

我收到此类错误：

我的目标是从另一个 sheet（在另一个工作簿中）复制数据并将其粘贴到我的主 workbook/worksheet 中现有的 table。首先，我清除数据然后插入新数据。我循环的每个 sheet 在我的主工作簿中都有一个对应的 sheet。每个 sheet 只有 1 个列表对象 (table)。到目前为止实现了以下代码（这似乎与我当前的问题相关）：

Option Explicit
'Declaring all public variables and constants

' Strings
Public InputPath        As String
Public OutputPath       As String
Public DataFile         As String

' Integers
Public i                As Integer
Public j                As Integer
Public k                As Integer
Public fr               As Integer
Public fc               As Integer
Public lr               As Integer
Public lc               As Integer

' Workbooks and worksheets
Public Wkb              As Workbook
Public Ws               As Worksheet
Public Tws              As Worksheet

'Objects, ranges, arrays
Public NewData          As Range
Public tbl              As ListObject

Sub main()
' This sub is used to set public variables

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

InputPath = "MyInputPath\"
OutputPath = "MyOutputPath\"
DataFile = "MyFile.xlsx"

Call UpdateData

ThisWorkbook.Sheets(1).Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Sub UpdateData()
' This sub updates data (fetching new sheets from generated Excel-file)

' Updating sheets
    Application.DisplayAlerts = False
    Workbooks.Open Filename:=OutputPath & DataFile
    Set Wkb = Workbooks(DataFile)

    With Wkb
        k = .Worksheets.Count
        For i = 1 To k ' Number of default worksheets to all worksheets
            For Each Ws In ThisWorkbook.Worksheets
                If .Worksheets(i).Name = Ws.Name Then ' Finding matching worksheet
                    Set Tws = .Sheets(i)
                    Set tbl = Ws.ListObjects(1)
                        With tbl ' Deleting data from current table in the worksheet
                            If Not .DataBodyRange Is Nothing Then
                                .Rows.Delete
                            End If
                        End With
                    fr = WorksheetFunction.Match("ConsistentKeyword", Ws.Columns(1), 0) - 3 ' First row
                    fc = 1 ' First column
                    lc = Tws.Cells(fr, fc).End(xlToRight).Column ' Last column
                    lr = Tws.Cells(fr, fc).End(xlDown).Row - 3 ' Last row
                    Set NewData = Tws.Range(Tws.Cells(fr, fc), Tws.Cells(lr, lc))
                    NewData.Copy              
                    tbl.DataBodyRange.PasteSpecial xlPasteValues '<--- OBS ERROR IS IN THIS LINE
                    Application.CutCopyMode = False
                End If
            Next Ws
        Next i
        .Close SaveChanges:=False
    End With

    Application.DisplayAlerts = True

End Sub

注意我的错误发生在tbl.DataBodyRange.PasteSpecial xlPasteValues

编辑：我尝试添加代码：

Ws.Activate
tbl.Range(2, 1).Select
Selection.PasteSpecial xlpastevalues

而不是：

tbl.DataBodyRange(1, 1).PasteSpecial xlPasteValues

但这会产生 运行时间错误“1004”：为此，所有合并的单元格都需要具有相同的大小。，但是 none 我复制的单元格被合并。由于这需要激活工作sheet和选择我宁愿解决我的原始代码。

Answer 1

我通过在 with tbl 子句中添加行 .ListRows.Add 并设置（以保持源格式）来让我的代码工作：

                NewData.Copy
                tbl.DataBodyRange(1, 1).PasteSpecial

感谢@SJR 的提示。

VBA: 正在将数据复制到现有列表对象中

VBA: Copying data into existing listobject

error-handling

excel

vba

listobject