excel - VBA : Copying data into existing listobject

Question

我收到此类型的错误:



我的目标是从另一个工作表(在另一个工作簿中)复制数据，并将其粘贴到我的主工作簿/工作表中的现有表中。首先，我清除数据，然后插入新数据。我遍历的每个工作表在主工作簿中都有一个对应的工作表。每张纸只有1个列表对象(表)。
到目前为止，以下代码已实现(这似乎与我当前的问题有关):

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”:为此，所有合并的单元格都必须具有相同的大小。但是，我复制的所有单元格都没有合并。因为这需要激活工作表和选择，所以我宁愿解决我的原始代码。

Answer 1

通过在.ListRows.Add子句中添加with tbl行并进行设置(以保持源格式)，我的代码可以工作:

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

感谢@SJR的提示。