複製/粘貼/計算過濾表的一列中的可見單元格

Question

我使用AutoFilter來對VBA中的表格進行排序，從而生成較小的數據表。我只想在應用過濾器後複製/粘貼一列的可見單元格。此外，我想平均一列的過濾值並將結果放入不同的單元格。

我在Stack上發現了這個片段，它允許我複製/粘貼過濾器的整個可見結果，但我不知道如何修改它或以其他方式獲取一列值的數據（沒有頭）從它。

Range("A1",Cells(65536,Cells(1,256).End(xlToLeft).Column).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy 
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 
Application.CutCopyMode = False 

加成回答（與濾波值計算）：

tgt.Range("B2").Value =WorksheetFunction.Average(copyRange.SpecialCells(xlCellTypeVisible)) 

Answer 1

我設置了一個簡單的3列區域Sheet 1上與國家，城市，和A語言中的列， B和C.以下代碼自動篩選範圍，然後僅將其中一列自動篩選數據粘貼到另一個工作表。你應該能夠修改此爲您的目的：

Sub CopyPartOfFilteredRange() 
    Dim src As Worksheet 
    Dim tgt As Worksheet 
    Dim filterRange As Range 
    Dim copyRange As Range 
    Dim lastRow As Long 

    Set src = ThisWorkbook.Sheets("Sheet1") 
    Set tgt = ThisWorkbook.Sheets("Sheet2") 

    ' turn off any autofilters that are already set 
    src.AutoFilterMode = False 

    ' find the last row with data in column A 
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row 

    ' the range that we are auto-filtering (all columns) 
    Set filterRange = src.Range("A1:C" & lastRow) 

    ' the range we want to copy (only columns we want to copy) 
    ' in this case we are copying country from column A 
    ' we set the range to start in row 2 to prevent copying the header 
    Set copyRange = src.Range("A2:A" & lastRow) 

    ' filter range based on column B 
    filterRange.AutoFilter field:=2, Criteria1:="Rio de Janeiro" 

    ' copy the visible cells to our target range 
    ' note that you can easily find the last populated row on this sheet 
    ' if you don't want to over-write your previous results 
    copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A1") 

End Sub 

注意，通過使用上面的語法來複制和粘貼，沒有選擇或激活（你應該總是避免在Excel VBA）和剪貼板不用過的。因此，Application.CutCopyMode = False是沒有必要的。

Answer 2

只需添加到Jon的編碼，如果你需要把它更進了一步，做的不僅僅是一列越多，你可以添加類似

Dim copyRange2 As Range 
Dim copyRange3 As Range 

Set copyRange2 =src.Range("B2:B" & lastRow) 
Set copyRange3 =src.Range("C2:C" & lastRow) 

copyRange2.SpecialCells(xlCellTypeVisible).Copy tgt.Range("B12") 
copyRange3.SpecialCells(xlCellTypeVisible).Copy tgt.Range("C12") 

把這些附近是相同的，你的其他值編碼可以根據需要輕鬆更改範圍。

我只是補充一點，因爲這對我很有幫助。我認爲喬恩已經知道這一點，但對於那些經驗較少的人來說，有時候看看如何更改/添加/修改這些編碼是有幫助的。我想，因爲Ruya不知道如何操作原始編碼，如果有人需要複製2個可見列或3個等，這可能會有所幫助。您可以使用相同的編碼，添加幾乎幾乎相同的編碼相同的，然後編碼複製你需要的任何東西。

我沒有足夠的聲望直接回復Jon的評論，所以我不得不作爲新評論發佈，對不起。

Answer 3

我發現這個工作得很好。它使用.autofilter對象，這似乎是一個相當模糊，而且非常輕便，功能的.range屬性：如果您要平均濾波範圍的一部分

Sub copyfiltered() 
    ' Copies the visible columns 
    ' and the selected rows in an autofilter 
    ' 
    ' Assumes that the filter was previously applied 
    ' 
    Dim wsIn As Worksheet 
    Dim wsOut As Worksheet 

    Set wsIn = Worksheets("Sheet1") 
    Set wsOut = Worksheets("Sheet2") 

    ' Hide the columns you don't want to copy 
    wsIn.Range("B:B,D:D").EntireColumn.Hidden = True 

    'Copy the filtered rows from wsIn and and paste in wsOut 
    wsIn.AutoFilter.Range.Copy Destination:=wsOut.Range("A1") 
End Sub