Pasting into an Autofiltered Block

[Alex Hulse]

I'm writing a macro which takes a range of cells from worksheet a,
performs an autofilter on worksheet b and then tries to paste a's range
into the autofiltered section in b. BUT that doesn't work, as it pastes
into rows that can't be seen.

Given that selecting only the visible cells doesn't work with
ActiveSheet.Paste (it doesn't seem to like pasting into multiple
selections, can't blame it really) can anyone see a way out or do i have
to come up with something a bit more complicated?

Alex Hulse

 

[Dave Peterson]

I think more complicated.

How about finding the range of visible cells in the first column of the
autofilter range.

Then go through each range pasting row by row.

But there's lots of things to check.

If you want to copy more rows than you have visible rows, what should happen?
If you copy more (or less) columns than the autofilter range, how should that be
pasted?

(ok, Lots = 2!)

I chose to just yell and quit (but you can change it to do what you like):

Option Explicit
Sub testme()

Dim RngToCopy As Range
Dim RngToPaste As Range
Dim myCell As Range
Dim rCtr As Long

Set RngToCopy = Nothing
On Error Resume Next
'and no multiple areas!
Set RngToCopy = Application.InputBox _
(Prompt:="Please select a range to copy", _
Type:=8).Areas(1)
On Error GoTo 0

If RngToCopy Is Nothing Then
Exit Sub
End If

With Worksheets("sheet1").AutoFilter.Range
If .Columns(1).Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
'only header row is visible--abort, abort, abort!
MsgBox "Nope, can't do it"
Exit Sub
End If
Set RngToPaste = .Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)

'some kind of checking here??
If RngToPaste.Cells.Count < RngToCopy.Rows.Count Then
MsgBox "not enough rows to paste into!"
Exit Sub
End If

If RngToCopy.Columns.Count <> .Columns.Count Then
MsgBox "not right number of columns!"
Exit Sub
End If

rCtr = 0
For Each myCell In RngToPaste.Cells
rCtr = rCtr + 1
If rCtr > RngToCopy.Rows.Count Then
Exit For
End If

RngToCopy.Rows(rCtr).Copy _
Destination:=myCell
Next myCell
End With
End Sub

 

[Alex Hulse]

I think more complicated.

<snip>

Thanks very much for that! I've had to adapt it slighty - mainly through
playing with offsets and things to get it to fit into my exact
circumstance, but your code got me out of a very very boring couple of
days of copy and paste!

Alex