Menu
  1. Accueil
  2. Tech Forum
  3. Office Software
  4. Excel

Trying to insert multiple rows between rows in excel with copied data. [Closed]

Report
Posts
1
Registration date
Sunday June 9, 2019
Status
Member
Last seen
June 9, 2019
 -
Posts
2674
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 27, 2020
 -
Hello,
I have used the two listed vba macros but i am having no luck combining the two.
First one to add 13 rows between current data: data is on sheet 1
Sub test()
Dim j As Long, r As Range
j = InputBox("type the number of rows to be insered")
Set r = Range("A2")
Do
Range(r.Offset(1, 0), r.Offset(j, 0)).EntireRow.Insert
Set r = Cells(r.Row + j + 1, 1)

If r.Offset(1, 0) = "" Then Exit Do
Loop

End Sub

2nd one to copy rows : data is on sheet 2

Sub MoveCopyRowsColumns()

Rows("1:13").Copy
Rows(15).Insert
End Sub

examble of sheet 1
PartTran_PartNum
290000002
290000007
290000110
290000144
290000176
290000184
290000320
290000322
290000323
290000342
290000387
290000414

example of sheet 2
01 Jan
02 Feb
03 Mar
04 Apr
05 May
06 Jun
07 Jul
08 Aug
09 Sep
10 Oct
11 Nov
12 Dec
TOTAL

Desired outcome
PartTran_PartNum
290000002
01 Jan
02 Feb
03 Mar
04 Apr
05 May
06 Jun
07 Jul
08 Aug
09 Sep
10 Oct
11 Nov
12 Dec
TOTAL
290000007
01 Jan
02 Feb
03 Mar
04 Apr
05 May
06 Jun
07 Jul
08 Aug
09 Sep
10 Oct
11 Nov
12 Dec
TOTAL
290000110
01 Jan
02 Feb
03 Mar
04 Apr
05 May
06 Jun
07 Jul
08 Aug
09 Sep
10 Oct
11 Nov
12 Dec
TOTAL



System Configuration: Windows / Chrome 75.0.3770.80
See more

1 reply

Answer 1 / 1
Posts
2674
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 27, 2020
 446
Hi Visco,

May I suggest a different code as it is easier to work for the bottom up when inserting.

Give this a shot: 
Sub RunMe()
Dim lRow, x As Integer

lRow = Sheets("Sheet1").Range("A1").End(xlDown).Row + 1

For x = lRow To 3 Step -1
    Sheets("Sheet2").Range("A1:A13").Copy
    Range("A" & x).Insert Shift:=xlDown
Next x
End Sub


Best regards,
Trowa
Ask a question