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
|