Error when pasting to just visible cells

soroush.kalantari · #1 08-05-2023, 12:45 AM

have written following macro to paste copied data to just visible cells. It fails to work for the cells which are immediately after a hidden cell. (See the attachment, if I copy range A1:c1 from “ rowdata sheet” and then select range c1:f1 from “pastdata”sheet, when running the code, I expect c1 value of “ rowdata sheet” sheet be pasted to f1 in “pastdata” sheet but it is pasted on c6 in the “pastdata”sheet instead.
Can you guide me on this issue?

Sub pasttojustvisblecells()
Application.DisplayAlerts = False
Dim ws As Worksheet
Dim rng As Range
Dim rng1 As Range
Dim n As Integer
Dim i As Integer

Dim ws1 As Worksheet
Set ws = ActiveSheet

Set rng = Selection.SpecialCells(xlCellTypeVisible)
n = rng.SpecialCells(xlCellTypeVisible).Cells.Count
MsgBox rng.Address

Sheets.Add After:=ActiveSheet
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rng1 = Selection
Set ws1 = ActiveSheet

For i = 1 To n
ws1.Activate
rng1.Cells(i).Select
Selection.Copy
ws.Activate

rng.Cells(i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Next i
ws1.Activate
ActiveSheet.Delete
ws.Activate
Application.DisplayAlerts = True
End Sub

p45cal · #2 08-05-2023, 10:14 AM

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

soroush.kalantari · #3 08-05-2023, 08:09 PM

Quote:

Originally Posted by p45cal

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

Thank you for your complete and constructive answer which solved my problem. I added a new worksheet because without this, I didn’t know how to set rng1. Do you know a way to use copied data in this code without adding new worksheet? Can you tell me why the line “rng.Cells(i).Select” in my code failed? (these questions are just for improving my understanding of vba)

p45cal · #4 08-06-2023, 06:55 AM

Quote:

Originally Posted by soroush.kalantari

I added a new worksheet because without this, I didn’t know how to set rng1. Do you know a way to use copied data in this code without adding new worksheet?

OK, I understand. It's fine.

Quote:

Originally Posted by soroush.kalantari

Can you tell me why the line “rng.Cells(i).Select” in my code failed? (these questions are just for improving my understanding of vba)

Since rng is a noncontiguous range (as you could see with your MsgBox rng.Address), it has multiple areas (each of these areas is separated by a comma in the .Address), but when you use rng.cells(i) it in fact only refers to area 1, and when that area is too small, say it's got only 2 cells, then when you say rng.cells(3) it refers to a different but clearly defined cell; to demonstrate:
execute this line:

Code:

range("H10:I10, K10").Select

the green cells will be selected, then execute:

Code:

selection.cells(8).select

the cell with the label 8 will be selected where I've inserted the numbering system:
2023-08-06_144659.jpg
Using For each cll in rng.cells does iterate properly through a noncontiguous range.

Note that with the new code, it does matter how you select the destination range; you will get a different result if you start at the left when dragging, from if you start at the right, as the MsgBox rng.Address will show!

soroush.kalantari · #5 08-06-2023, 08:15 PM

Ok. I got it. Thank you very much.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
error handler: inserting building blocks when multiple cells in a table are selected creates error	LSLSLS	Word VBA	2	01-07-2022 05:46 AM
for visible cells (filtered), how find value lowest than 4.00 and return the cell number	murfy69	Excel	6	08-03-2017 12:03 AM
VBA color of visible gridlines of tables word (with some merged cells in first rows)	Alvaro.passi	Word VBA	0	07-18-2017 09:11 AM
Losing rows when pasting split cells	Gitley	Word Tables	1	01-15-2013 07:49 AM
In Excel 2007-After Selecting Visibe Cells-How do I "Copy to Visible cells" Only	mag	Excel	0	10-28-2012 08:04 PM