Copy visible cells only in 365?

StefanoValenza 

With this macro you can easily copy-paste values from & to visible cells only.

It works like this:
Run the code > an inputbox will pop up > select the range to copy > OK > another inputbox will pop up > select the range to paste (select the first cell only) > OK.

If you need to use it frequently, you can put the code in a code module in the "Personal.xlsb" and then assign it to a button in the toolbar menu. So you just have to click the button when you need to run it.

Sub CopyVisibleToVisible1()
'use this for:
'Copy paste(value only):
'from filtered range to filtered range
'from filtered range to unfiltered range
'from unfiltered range to filtered range
'Not work on hidden column

'How it works:
'Run the code > an inputbox will pop up > select the range to copy > OK > anoher inputbox will pop up
' > select the range to paste (select the first cell only) > OK
    
'If you need to use it frequently, you can put the code in a code module in the "Personal.xlsb" and
'then assign it to a button in the toolbar menu. So you just have to click the button when you need to run it.
    
    Dim rngA As Range
    Dim rngB As Range
    Dim r As Range
    Dim Title As String
    Dim ra As Long
    Dim rc As Long
    
    On Error GoTo skip:
    
    Title = "Copy Visible To Visible"
    Set rngA = Application.Selection
    Set rngA = Application.InputBox("Select Range to Copy then click OK:", Title, rngA.Address, Type:=8)
    
    Set rngB = Application.InputBox("Select Range to Paste (select the first cell only):", Title, Type:=8)
    Set rngB = rngB.Cells(1, 1)
    Application.ScreenUpdating = False

    ra = rngA.Rows.Count
    rc = rngA.Columns.Count
    If ra = 1 Then rngB.Resize(, rc).Value = rngA.Value: Exit Sub
    
    
    Set rngA = rngA.Cells(1, 1).Resize(ra, 1)
    
    For Each r In rngA.SpecialCells(xlCellTypeVisible)
      rngB.Resize(1, rc).Value = r.Resize(1, rc).Value
        Do
          Set rngB = rngB.Offset(1, 0)
        Loop Until rngB.EntireRow.Hidden = False
    Next
    
    Application.GoTo rngB
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    

Exit Sub
skip:
    If err.Number <> 424 Then
        MsgBox "Error found: " & err.Description
    End If
    
    Application.ScreenUpdating = True
    Application.CutCopyMode = False

End Sub