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