VBA: копирование данных в существующий объект списка - PullRequest
Новая
       33

VBA: копирование данных в существующий объект списка

0 голосов
/ 19 февраля 2019

Я получаю сообщение об ошибке этого типа:

Error 91

Моя цель - скопировать данные с другого листа (из другой рабочей книги) и вставить их всуществующая таблица в моей основной книге / листе.Сначала я очищаю данные, затем вставляю новые данные.Каждый лист, который я перебираю, имеет соответствующий лист в моей основной книге.На листе только 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

EDIT : Iпопытался добавить код: 

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

Вместо: 

tbl.DataBodyRange(1, 1).PasteSpecial xlPasteValues

Но это приводит к ошибке времени выполнения '1004': для этого все объединенные ячейки должныбыть одинакового размера. , однако ни одна из копируемых ячеек не объединяется.Поскольку это требует активации рабочего листа и выбора, я бы лучше решил мой оригинальный код.

1 Ответ

0 голосов
/ 22 февраля 2019

Я получил свой код для работы, добавив строку .ListRows.Add в предложении with tbl и настройку (для сохранения исходного формата): 

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

Спасибо @SJR за подсказку.

...