OK, Joyce, I had to do some rearranging to make this work without knowing
where everything is located on your worksheet, but it tested OK, and your
named range will be put back to where it originally was. Any time you use
the insert method and include a named range in the area to be inserted, it
will move the named range and change the refersto reference, so the last two
lines of code (3 as shown) will put it back after it is moved.
This also avoids the pasting across the full row.

Dim rng As Range, i As Long, sh As Worksheet
Dim shNm As String, rAddr As String
Set sh = ActiveSheet
shNm = ActiveSheet.Name
Set rng = ActiveCell.CurrentRegion
i = rng.Rows.Count
Application.Goto Reference:="SpecDate"
rAddr = ActiveCell.Address
If i = 1 Then
ActiveCell.EntireRow.Insert
rng.Copy Range("SpecDate").Offset(-1, 0)
Else
ActiveCell.Resize(i, 1).EntireRow.Insert
rng.Copy Range("SpecDate").Offset(-i, 0)
End If
ActiveWorkbook.Names("SpecDate").Delete
ActiveWorkbook.Names.Add Name:="SpecDate", _
RefersTo:="=" & shNm & "!" & rAddr


"Joyce" wrote in message
...
Hi there,

I tried the update code, but end up with 2 problems:

1. It pastes underneath the row that contains the SpecDate cell. I want
it
to paste starting in the SpecDate cell.

2. It doesn't insert entire rows, so it pushes down parts of rows beneath
(cols A and B) but leave col C where it was, so messes up the data.

If you have any other ideas, it would be greatly appreciated.

Thanks

"JLGWhiz" wrote:

If I understand what you want this should work:



Dim rng As Range, i As Long
Set rng = ActiveCell.CurrentRegion
i = rng.Rows.Count
rng.Copy
Application.Goto Reference:="SpecDate"
If i = 1 Then
ActiveCell.Offset(1, 0).Resize(1, 2).Insert Shift:=xlDown
Else
ActiveCell.Offset(1, 0).Resize(i, 2).Insert Shift:=xlDown
End If







"JLGWhiz" wrote in message
...
Change this:
If i = 1 Then
rng.PasteSpecial Paste:=xlPasteAll
Else
ActiveCell.EntireRow.Resize(rowsize:=i - 1).Insert Shift:=xlDown
rng.PasteSpecial Paste:=xlPasteAll
End If

To this:

If i = 1 Then
ActiveCell.PasteSpecial Paste:=xlPasteAll
Else
ActiveCell.Resize(rowsize:=i ).EntireRow.Insert Shift:=xlDow
End If




"Joyce" wrote in message
...
Hi,

I'm trying to copy and paste filtered data on Wksht A into a report on
Wksht
B. The number of lines in the filtered range on Wksht A will vary for
each
report.

The upper left paste location on Wkst B is a cell named SpecDate.

I want to insert extra complete rows if the filtered data is greater
than
1
row. This is because I have other report sections below the
destination
that
I wish to push down.

I've tried a few ways, but to no avail. This is my latest attempt - I
don't
get errors but nothing pastes. I'm *not* great in VBA, as you can
see.
Thanks!

Dim rng As Range, i As Long

Set rng = ActiveCell.CurrentRegion
rng.Select
i = rng.Rows.Count

rng.Copy
Application.Goto Reference:="SpecDate"

If i = 1 Then
rng.PasteSpecial Paste:=xlPasteAll
Else
ActiveCell.EntireRow.Resize(rowsize:=i - 1).Insert Shift:=xlDown
rng.PasteSpecial Paste:=xlPasteAll
End If






.