Excel VBA在过滤数据中复制范围并附加到另一个工作表上的表末尾

Question

我有一个问题，但我的 VBA 是新手，无法弄清楚我的代码出了什么问题。

我想要实现的是：

第 1 步。在工作表 1 中，单元格 B8:BR8 的标题下方有很多数据

第 2 步。我在单元格 BE8 上过滤非空白

第 3 步。我复制了 BE8:BN8 下的过滤数据（不包括标题，我不需要所有数据，因此我只是复制完整数据的一个子集）

第 4 步。我转到表 2，其中有一个填充表，其中 C8:L8 中的标题与表 1 中的标题 BE8:BN8 完全对应

第 5 步。我想将这个新复制的数据集附加到表 2 中该表的末尾

第 6 步。我想回到工作表 1 并删除一些过滤后的数据，特别是标题 BE8,BK8:BN8 下的数据

这是我尝试从另一个代码改编的尝试：

Sub TransferData()

    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim RngBeforeFilter As Range, RngAfterFilter As Range
    Dim LCol As Long, LRow As Long

    With ThisWorkbook
        Set WS1 = .Sheets("Sheet1")
        Set WS2 = .Sheets("Sheet2")
    End With

    With WS1
        'Make sure no other filters are active.
        .AutoFilterMode = False

        'Get the correct boundaries.
        LRow = .Range("BE" & .Rows.Count).End(xlUp).Row
        LCol = .Range("BE8:BN8").Column

        'Set the range to filter.
        Set RngBeforeFilter = .Range(.Cells(1, 2), .Cells(LRow, LCol)).Offset(1)
        RngBeforeFilter.Rows(8).AutoFilter Field:=56, Criteria1:="<>"

        'Set the new range, but use visible cells only.
        Set RngAfterFilter = .Range(.Cells(1, 7), .Cells(LRow, LCol)).SpecialCells(xlCellTypeVisible)

        'Copy the visible cells from the new range.
        RngAfterFilter.Copy WS2.Range("C65536").End(xlUp)

        'Clear filtered data (not working)
        Sheets("Sheet1").Range("B8", Range("B8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
        .ShowAllData

    End With

End Sub

如果您能提供任何帮助，我将不胜感激。

谢谢 雅克

Answer 1

这里有几个问题：

.Range("BE8:BN8").Column

可能没有按照您的预期进行 - 它只会返回 BE 的列号（即 57）。

RngBeforeFilter 什么都不做 - 你可以使用

.Rows(8).AutoFilter Field:=56, Criteria1:="<>"

您说要复制 BE:BN 中的数据，但您从 A 列（即 .Cells(1, 7)）启动 RngAfterFilter。

WS2.Range("C65536").End(xlUp)

给出使用的最后一行，而您需要粘贴到下一行。

您正在清除 B 列，而不是 BE、BK 和 BN 列。

因此，请尝试以下方法：

 Sub TransferData()

Dim WS1 As Worksheet, WS2 As Worksheet
Dim RngBeforeFilter As Range, RngAfterFilter As Range
Dim BECol As Long, BNCol As Long, LRow As Long

With ThisWorkbook
    Set WS1 = .Sheets("Sheet1")
    Set WS2 = .Sheets("Sheet2")
End With

With WS1
    'Make sure no other filters are active.
    .AutoFilterMode = False

    'Get the correct boundaries.
    LRow = .Range("BE" & .Rows.Count).End(xlUp).Row
    BECol = .Range("BE8").Column
    BNCol = .Range("BN8").Column

    'Set the range to filter.
    .Rows(8).AutoFilter Field:=BECol - 1, Criteria1:="<>"

    'Set the new range, but use visible cells only.
    Set RngAfterFilter = .Range(.Cells(9, BECol), .Cells(LRow, BNCol)).SpecialCells(xlCellTypeVisible)
    'Copy the visible cells from the new range.
    RngAfterFilter.Copy WS2.Range("C65536").End(xlUp).Offset(1)

    'Clear filtered data
    .Range("BE9", Range("BE8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
    .Range("BK9", Range("BK8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
    .Range("BN9", Range("BN8").End(xlDown)).SpecialCells(xlCellTypeVisible).ClearContents
    .ShowAllData

End With

End Sub