Question

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

我想要实现的目标是：

第1步。在表1中，我在单元格B8：BR8

中的标题下面有大量数据

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

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

第4步。我去了Sheet 2，在那里我有一个填充表格，其中标题为C8：L8，完全对应于标题BE8：来自Sheet 1的BN8

第5步。我想将这个新复制的数据集附加到Sheet 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列开始RngAfterFilter（即.Cells（1,7））。

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

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

1 个答案: