Copy/Paste/Calculate Visible Cells from One Column of a Filtered Table

I set up a simple 3-column range on Sheet1 with Country, City, and Language in columns A, B, and C. The following code autofilters the range and then pastes only one of the columns of autofiltered data to another sheet. You should be able to modify this for your purposes:

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

Note that by using the syntax above to copy and paste, nothing is selected or activated (which you should always avoid in Excel VBA) and the clipboard is not used. As a result, Application.CutCopyMode = False is not necessary.

Just to add to Jon's coding if you needed to take it a step further, and do more than just one column you can add something like

Dim copyRange2 As RangeDim copyRange3 As RangeSet 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")

put these near the other codings that are the same you can easily change the Ranges as you need.

I only add this because it was helpful for me. I'd assume Jon already knows this but for those that are less experienced sometimes it's helpful to see how to change/add/modify these codings. I figured since Ruya didn't know how to manipulate the original coding it could be helpful if one ever needed to copy over only 2 visibile columns, or only 3, etc. You can use this same coding, add in extra lines that are almost the same and then the coding is copying over whatever you need.

I don't have enough reputation to reply to Jon's comment directly so I have to post as a new comment, sorry.

Here a code that works with windows office 2010. This script will ask you for input filtered range of cells and then the paste range.

Please, both ranges should have the same number of cells.

Sub Copy_Filtered_Cells()Dim from As VariantDim too As VariantDim thing As VariantDim cell As Range'Selection.SpecialCells(xlCellTypeVisible).Select    'Set from = Selection.SpecialCells(xlCellTypeVisible)    Set temp = Application.InputBox("Copy Range :", Type:=8)    Set from = temp.SpecialCells(xlCellTypeVisible)    Set too = Application.InputBox("Select Paste range selected cells ( Visible cells only)", Type:=8)    For Each cell In from        cell.Copy        For Each thing In too            If thing.EntireRow.RowHeight > 0 Then                thing.PasteSpecial                Set too = thing.Offset(1).Resize(too.Rows.Count)                Exit For            End If        Next    NextEnd Sub

Enjoy!