Search code examples
excelvbaerror-handlinglistobject

VBA: Copying data into existing listobject

I receive an error of this type:

Error 91

My goal is to copy data from another sheet (in another workbook) and paste it into an existing table in my main workbook/worksheet. First, I clear the data then I insert the new data. Each sheet I loop through has a corresponding sheet in my main workbook. There is only 1 listobject (table) per sheet. The following code is implemented thus far (that seems relevant to my current problem):

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

Note that my error occurs at tbl.DataBodyRange.PasteSpecial xlPasteValues

EDIT: I tried adding the code:

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

Instead of :

tbl.DataBodyRange(1, 1).PasteSpecial xlPasteValues

But that yields the run-time error '1004': To do this, all merged cells need to be the same size., however none of the cells I copy are merged. Since this requires activation of worksheet and selection I would rather solve my original code.

Solution

  • I got my code to work by adding the line .ListRows.Add in the with tbl clause and setting (to keep source format):

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

    Thanks to @SJR for the tip.