ListRows.Add函数从原始表中删除数据

Question

昨天，我对这个问题的问题已解决：

VBA Copy/Paste Data from Source Table into Target Table when DataBodyRange is Nothing

现在，当DataBodyRange为Nothing时，我可以将数据“添加”到表中。

但是有一个意外的结果，我无法用ListRows.Add方法解决。

步骤：

1. 我调用引用的例程，并从SOURCE（左侧）表中选择一个值。数据将被过滤并正确粘贴到TARGET（右侧）表中。
2. 我再次调用例程。在ListRows.Add函数之后，立即从SOURCE表中删除一行（我在代码中放置了“ Stops”以诊断问题的位置。）

这是第一站第二次跑步的照片。

这是ListRows.Add之后第二次跑步的照片

这是显示了Stops的代码。

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

Set loSource = Sheets("ProductData").ListObjects("tblProductData")
Set loTarget = Sheets("ProductData").ListObjects("tblMyProducts")
Set myfilter = Range("ShipToNumber")

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

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

'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

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

'Check to see if there is data in table
    If Not loTarget.DataBodyRange Is Nothing Then
        loSource.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy 'Copy Data from Source Table to Target Table
        loTarget.DataBodyRange.PasteSpecial (xlPasteValues)
    Else

        STOP 'First Stop
             loTarget.ListRows.Add
        STOP 'Second Stop

        loSource.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy loTarget.DataBodyRange(1, 1)
    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

任何帮助将不胜感激。

最重要的是，我正在尝试将一系列过滤后的值从源表复制/粘贴到目标表，以便可以在下拉菜单，组合框等中使用目标表数据。

在此先感谢您的帮助。 迈克尔

Answer 1

我最终将两个表分成了两个不同的表。问题解决了。

由于某种原因，一个表在同一张纸上时会不断从另一张表中删除行。