Insert Rows if Pasting more Than 1 Row

[Joyce]

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

 

[JLGWhiz]

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]

Hello,

I posted a reply, but don't see it, so will repost. My apologies if it
appears twice.

I tried your code and it worked great for pasting one row. However when
pasting more than one row, I encountered 2 problems:

1. The rows that i'm pasting consist of 2 columns. On each row where they
are pasted, the columns repeat over and over, all the way to column IV. I
tried adding columnsize:=2

ActiveCell.Resize(rowsize:=i, columnsize:=2).EntireRow.Insert Shift:=xlDown

but that didn't help.

2. The upper destination cell named SpecDate gets shifted down (the entire
row does) and ends up beneath the pasted rows. I'd like it to stay at the
first row in the paste range.

Thanks!

 

[JLGWhiz]

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

 

[Joyce]

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]

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