View Single Post
 
Old 08-05-2023, 10:14 AM
p45cal's Avatar
p45cal p45cal is offline Windows 10 Office 2021
Expert
 
Join Date: Apr 2014
Posts: 956
p45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond repute
Default

See attached and comments in code.
Code:
Sub pasttojustvisblecells()
Application.DisplayAlerts = False
Dim AtLeast1CellVisible, ws As Worksheet, rng As Range, rng1 As Range, cll, i As Long

Dim ws1 As Worksheet
Set ws = ActiveSheet
Set rng = Selection
'This next section is to cater for when only one cell is selected on the destination sheet; if only one cell is selected
'.SpecialCells includes all the visible cells on the entire worksheet!
'*********************
For Each cll In rng.Cells 'this loop ensures at least one cell in the selection is visible.
  If Not (cll.EntireColumn.Hidden Or cll.EntireRow.Hidden) Then
    AtLeast1CellVisible = True
    Exit For
  End If
Next cll
'*********************

If AtLeast1CellVisible Then
  If rng.Cells.Count = 1 Then Set rng = Selection Else Set rng = rng.SpecialCells(xlCellTypeVisible)
'  MsgBox rng.Address
  Set ws1 = Sheets.Add ' After:=ActiveSheet 'I'm not sure why you do this…
  ws1.Cells(1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Set rng1 = Selection

  i = 0
  For Each cll In rng
    i = i + 1
    cll.Value = rng1.Cells(i).Value
  Next cll

  ws1.Delete
  'ws.Activate 'shouldn't need this
Else
  MsgBox "No visible cells selected to paste to" 'this could happen if you hid all selected cells.
End If
Application.DisplayAlerts = True
End Sub
Attached Files
File Type: xlsm msofficeforums51190pasttojustvisblecells.xlsm (28.3 KB, 5 views)
Reply With Quote