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作为提示。

VBA：将数据复制到现有列表对象

1 个答案: