I'm trying to figure out a way to copy and paste values from a filtered column and paste on the same index, but different column. Thake a look bellow how it should work:

Original:

Run VBA:

I tried SpecialCells(xlCellTypeVisible) but I couldn't make it work, because I need to copy only one specific column and not the entire sheet... can anyone help me? THANK YOU!

CodePudding user response：

Please, test the next code. It firstly create a columns slice from the filtered visible cells range and then processes each areas row:

Sub testCopyFilteredRangeAToB()
   Dim sh As Worksheet, rngF As Range, ar As Range, R As Range
   
   Set sh = ActiveSheet
   On Error Resume Next 'to avoid an error in case of no any visible cells
    Set rngF = sh.UsedRange.SpecialCells(xlCellTypeVisible)
   On Error GoTo 0
   If rngF Is Nothing Then Exit Sub 'if not range created, exit the code
   Set rngF = Intersect(sh.UsedRange.SpecialCells(xlCellTypeVisible), sh.Range("A:B"))
   
   For Each ar In rngF.Areas    'iterate between the range areas
        For Each R In ar.rows   'iterate between the area rows
            R.cells(1, 2).value = R.cells(1, 1).value 'copy the values, without using clipboard
        Next R
   Next ar
End Sub

CodePudding user response：

Filtered Column to Filtered Column

Option Explicit

Sub FilteredColumnToFilteredColumn()
    '*** (three lines) is indicating kind of the preferred order
    
    Const sCol As Long = 1 ' Source Column - being read from
    Const dCol As Long = 2 ' Destination Column - being written to
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    'If ws.FilterMode Then ws.ShowAllData '***
    
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion ' Range (has headers)
    Dim dcrg As Range ' Data Column Range (no headers)
    Set dcrg = rg.Resize(rg.Rows.Count - 1).Offset(1).Columns(dCol)
        
    'rg.AutoFilter X, "Yes" '***
        
    Dim vdcrg As Range ' Visible Data Column Range
    On Error Resume Next
        Set vdcrg = dcrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    ws.AutoFilterMode = False '***
    If vdcrg Is Nothing Then Exit Sub
    
    vdcrg.Formula = "=" & vdcrg.Cells(1).EntireRow.Columns(sCol).Address(0, 0)
    ' Note that you cannot do: 'vdcrg.Value = vdcrg.Value'
    
    ' This won't work if you haven't set the 'AutoFilterMode' to 'False'.
    ' Also, it is assumed that the whole column contains values, not formulas.
    ' Why would you write values to some of its cells if it contained formulas?
    dcrg.Value = dcrg.Value
   
End Sub