View Single Post
  #10   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default filtered pasting

I meant to add one more check...

Option Explicit
Sub testme()

Dim RngToCopy As Range
Dim RngToPaste As Range
Dim myCell As Range
Dim iRow As Long

Set RngToCopy = Nothing
On Error Resume Next
Set RngToCopy = Application.InputBox _
(Prompt:="Select a single column range to copy", Type:=8) _
.Areas(1).Columns(1)
On Error Resume Next

If RngToCopy Is Nothing Then
Exit Sub
End If

Set RngToPaste = Nothing
On Error Resume Next
Set RngToPaste = Application.InputBox _
(Prompt:="Select a single column range to paste", _
Type:=8).Areas(1).Columns(1) _
.Cells.SpecialCells(xlCellTypeVisible)
On Error Resume Next

'added this
If RngToPaste Is Nothing Then
Exit Sub
End If

If RngToCopy.Cells.Count RngToPaste.Cells.Count Then
MsgBox "not enough visible cells"
Exit Sub
End If

iRow = 0
For Each myCell In RngToPaste.Cells
RngToCopy.Cells(1).Offset(iRow, 0).Copy _
Destination:=myCell
iRow = iRow + 1
If iRow RngToPaste.Cells.Count Then
Exit For
End If
Next myCell

End Sub

Dave Peterson wrote:

This doesn't have too many validity checks, but it works if you select nice
ranges.

<<snipped