Hsieh

回復 1# idsmchow

1. Private Sub CommandButton1_Click()
   
2. Dim Sh As Worksheet, Rng As Range
   
3. For Each Sh In Sheets
   
4. If Sh.Name <> "Statement" Then   '略過Statement工作表
   
5. With Sh
   
6.   If .AutoFilter.Filters(3).On Then .ShowAllData   '如果C欄沒有被篩選
   
7.      .Range("A1").CurrentRegion.AutoFilter 3, Sheets("Statement").Range("G2"), xlAnd   '就以C欄篩選
   
8.      Set Rng = Intersect(.[A2:D65536], .AutoFilter.Range.SpecialCells(xlCellTypeVisible))    'A:D蘭蒂2列以下與篩選結果的可見儲存格交集部分
   
9.      If Not Rng Is Nothing Then Rng.Copy Sheets("Statement").Range("A65536").End(xlUp).Offset(1, 0)  '複製
   
10. End With
    
11. End If
    
12. Next
    
13. End Su

複製代碼