Copy Filtered Rows and Paste to Different Column

[Jeffrey Mahoney]

I created this macro to copy items in one column with filtered rows and past them into a different column. As you may know Excel fails at this task

This works, I just find part of the code to be clunky. The part that starts with For Each CC In PRng. Is there a better way to choose the next cell in a non-contiguous range?

Sub CopyFilteredValues()
  Dim CopyRng As Range
  Dim PRng As Range
  Dim Sel As Range
  Dim Cel As Range
  Dim CC As Range
  Dim TL As Range
  Dim X As Long
  Dim Y As Long
  
  If Application.CutCopyMode Then
    Set CopyRng = fGetClipboardRange
    Set CopyRng = CopyRng.SpecialCells(xlCellTypeVisible)
    If CopyRng.Columns.Count > 1 Then
      MsgBox "You may only copy one column at a time"
      Exit Sub
    End If
    
  Else
    MsgBox "You need to copy the range of numbers first"
    Exit Sub
  End If
  
  Set Sel = Selection
  Set PRng = Selection.SpecialCells(xlCellTypeVisible)
  If PRng.Count <> CopyRng.Count Then
    MsgBox "Please select the same number of rows as your copy range"
    Exit Sub
  End If
  
  Application.Calculation = xlCalculationManual
  
  X = 0
  Set TL = PRng.Areas(1).Resize(1, 1)
  For Each Cel In CopyRng
    X = X + 1
    Y = 0
    
[CODE=rich]
[B]For Each CC In PRng
      Y = Y + 1
      If Y = X Then
        CC.Value = Cel.Value
        Exit For
      End If
    Next CC[/B]

Next Cel
Application.Calculation = xlCalculationAutomatic

End Sub
[/CODE]

 

[Akuini]

Maybe this article would help:
Excel VBA: easy way to paste to visible cells