VBA Копирование / вставка данных из исходной таблицы в целевую таблицу, когда DataBodyRange имеет значение Nothing

Question

Мне нужна помощь с разрешением DataBodyRange - ошибка Nothing.

Я пытаюсь скопировать данные из отфильтрованной исходной таблицы в целевую таблицу. Данные целевой таблицы будут использоваться для выпадающих меню.

Когда я очищаю таблицу Target для подготовки к вставке следующих исходных данных, я иногда получаю ошибку времени выполнения, которая основана на том, что DataBodyRange - Nothing.

Я знаю, как вставить данные, когда в DataBodyRange есть что-то.

Мне нужен код для вставки исходных данных в целевую таблицу, когда DataBodyRange имеет значение Nothing.

См. Утверждение ELSE ниже.

Sub Copy_With_AutoFilter()

Dim loSource As Excel.ListObject
Dim loTarget As Excel.ListObject
Dim SourceDataRowsCount As Long
Dim TargetDataRowsCount As Long
Dim myfilter As Range
Dim rng As Range
Dim EndRow As ListRow

'Change ScreenUpdating, Calculation, EnableEvents, etc.
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    ActiveSheet.DisplayPageBreaks = False

'Prepare to Copy Specific Data from Source Table
Set loSource = Sheets("ProductData").ListObjects("tblProductData")
Set myfilter = Range("ShipToNumber")

'Create the Filter for the Source Table & Count Number of Cells
    loSource.Range.AutoFilter Field:=3, Criteria1:=myfilter
    SourceDataRowsCount = loSource.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Count

'Prepare to Paste that Data in Target Table
Set loTarget = Sheets("ProductData").ListObjects("tblMyProducts")

'Delete all Target table rows
    If Not loTarget.DataBodyRange Is Nothing Then
           loTarget.DataBodyRange.Delete
           loTarget.Resize Range("$J$1:$Q$2")
    End If

'Setup the Target Table
    If SourceDataRowsCount <> 0 Then
        Set rng = Range("tblMyProducts[#All]").Resize(SourceDataRowsCount + 1, 8)
        loTarget.Resize rng

'Copy Data from Source Table to Target Table
        loSource.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy

'Check to see if there is data in table
    If Not loTarget.DataBodyRange Is Nothing Then
        loTarget.DataBodyRange.PasteSpecial (xlPasteValues)
    Else
        'Set EndRow = loTarget.ListRows.Add
        'NEED HELP HERE:  Code to Add the Copied Rows from the Source table when DatabodyRange is Nothing
    End If

'Restore ScreenUpdating, Calculation, EnableEvents, etc.
        Sheets("ProductData").ListObjects("tblProductData").ShowAutoFilter = False
        Application.CutCopyMode = False
        ActiveWindow.View = ViewMode
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    Else
        MsgBox "Sorry, this Ship To location has not ordered any products in the last six months.  Please contact customer service so that your tables can be updated."
    End If

End Sub

Заранее спасибо.

Michael

Answer 1

Я думаю, что вам нужно сначала вставить строку. Вот простой пример, который, как мы надеемся, вы можете адаптировать (таблица 1 имеет 3 столбца).

Sub x()

Dim l As ListObject

Set l = Sheets(1).ListObjects("Table1")
If l.DataBodyRange Is Nothing Then
    l.ListRows.Add
    Range("F1:H1").Copy l.DataBodyRange(1, 1)
End If

End Sub