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

Question

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

TrowaD · Answer

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

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

1 response

Similar discussions

Subscribe To Our Newsletter!