Excel VBA在筛选数据内复制范围并将其追加到另一工作表的表尾

我有一个问题，但我的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

子传输数据（）
将WS1标注为工作表，将WS2标注为工作表
变暗RNG前置过滤器作为范围，RNG前置过滤器作为范围
变暗LCol为长，LRow为长
使用此工作簿
设置WS1=.Sheets（“Sheet1”）
设置WS2=.Sheets（“Sheet2”）
以
使用WS1
'确保没有其他过滤器处于活动状态。
.AutoFilterMode=False
'获取正确的边界。
LRow=.Range（“BE”&.Rows.Count）.End（xlUp）.Row
LCol=.Range（“BE8:BN8”）.列
'将范围设置为筛选。
设置RNGBeforFilter=.Range（.Cells（1，2），.Cells（LRow，LCol））.Offset（1）
RNGBeforfilter.Rows（8）。自动筛选字段：=56，标准1:=“”
'设置新范围，但仅使用可见单元格。
设置RngAfterFilter=.Range（.Cells（1,7），.Cells（LRow，LCol））.SpecialCells（xlCellTypeVisible）
'从新区域复制可见单元格。
RngAfterFilter.Copy WS2.Range（“C65536”）.End（xlUp）
'清除筛选数据（不工作）
工作表（“Sheet1”）。范围（“B8”，范围（“B8”）。结束（xlDown））。特殊单元格（xlCellTypeVisible）。ClearContents
.ShowAllData
以
端接头

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

谢谢 雅克这里有几个问题：

.Range("BE8:BN8").Column

可能没有达到您期望的效果-它只会返回BE的列号（ie 57）

RNGBeforFilter什么都不做-您可以使用

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

给出使用的最后一行，而您希望向下粘贴到下一行

您正在清除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

子传输数据（）
将WS1标注为工作表，将WS2标注为工作表
变暗RNG前置过滤器作为范围，RNG前置过滤器作为范围
颜色和颜色一样长，颜色和颜色一样长，颜色和颜色一样长
使用此工作簿
设置WS1=.Sheets（“Sheet1”）
设置WS2=.Sheets（“Sheet2”）
以
使用WS1
'确保没有其他过滤器处于活动状态。
.AutoFilterMode=False
'获取正确的边界。
LRow=.Range（“BE”&.Rows.Count）.End（xlUp）.Row
BECol=.Range（“BE8”）.列
BNCol=.Range（“BN8”）列
'将范围设置为筛选。
.行（8）.自动筛选字段：=BECol-1，标准1:=“”
'设置新范围，但仅使用可见单元格。
设置RngAfterFilter=.Range（.Cells（9，BECol），.Cells（LRow，BNCol））.SpecialCells（xlCellTypeVisible）
'从新区域复制可见单元格。
RngAfterFilter.Copy WS2.Range（“C65536”）.End（xlUp）.Offset（1）
'清除过滤数据
.Range（“BE9”，Range（“BE8”）.End（xlDown））.SpecialCells（xlCellTypeVisible）.ClearContents
.Range（“BK9”，Range（“BK8”）.End（xlDown））.SpecialCells（xlCellTypeVisible）。ClearContent
.Range（“BN9”，Range（“BN8”）.End（xlDown））.SpecialCells（xlCellTypeVisible）.ClearContent
.ShowAllData
以
端接头

这里有几个问题：

.Range("BE8:BN8").Column

可能没有达到您期望的效果-它只会返回BE的列号（ie 57）

RNGBeforFilter什么都不做-您可以使用

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

给出使用的最后一行，而您希望向下粘贴到下一行

您正在清除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

子传输数据（）
将WS1标注为工作表，将WS2标注为工作表
变暗RNG前置过滤器作为范围，RNG前置过滤器作为范围
颜色和颜色一样长，颜色和颜色一样长，颜色和颜色一样长
使用此工作簿
设置WS1=.Sheets（“Sheet1”）
设置WS2=.Sheets（“Sheet2”）
以
使用WS1
'确保没有其他过滤器处于活动状态。
.AutoFilterMode=False
'获取正确的边界。
LRow=.Range（“BE”&.Rows.Count）.End（xlUp）.Row
BECol=.Range（“BE8”）.列
BNCol=.Range（“BN8”）列
'将范围设置为筛选。
.行（8）.自动筛选字段：=BECol-1，标准1:=“”
'设置新范围，但仅使用可见单元格。
设置RngAfterFilter=.Range（.Cells（9，BECol），.Cells（LRow，BNCol））.SpecialCells（xlCellTypeVisible）
'从新区域复制可见单元格。
RngAfterFilter.Copy WS2.Range（“C65536”）.End（xlUp）.Offset（1）
'清除过滤数据
.Range（“BE9”，Range（“BE8”）.End（xlDown））.SpecialCells（xlCellTypeVisible）.ClearContents
.Range（“BK9”，Range（“BK8”）.End（xlDown））.SpecialCells（xlCellTypeVisible）。ClearContent
.Range（“BN9”，Range（“BN8”）.End（xlDown））.SpecialCells（xlCellTypeVisible）.ClearContent
.ShowAllData
以
端接头

您的代码到底出了什么问题，您试着调试了什么？它只是没有找到写列，然后又附加了标题。另外，明确的内容是删除所有记录。只是信息不够或问题不够具体，对不起。需要什么额外的信息？我已经明确了两个主要步骤，一个是从特定列复制过滤后的数据，另一个是将它们附加到表的末尾。我已经提供了我正在使用的编码，不确定什么信息不够丰富。真正有用的是一些Sheet1之前的模型，