Excel VBA复制范围内已过滤的数据和追加到另一个工作表上的表末尾

Question

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

我想要实现的是：

步骤1。在工作表1中，单元格B8中的标题下方有大量数据：BR8

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

步骤3。我复制BE8：BN8下的过滤数据（不包括标题，因此我不需要全部数据，因此我只是复制完整数据的一个子集）

步骤4。我去了Sheet 2，在那里我有一个C8：L8标题的填充表格，与表格1中的标题BE8：BN8完全一致。

Step 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 

可能不是做你所期望的 - 它只是返回时的列数（即57）。

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

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

你说你想中的数据复制：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