Previous Topic Next Topic

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

Closed
ElderVisco Posts 1 Registration date Sunday June 9, 2019 Status Member Last seen June 9, 2019 - Updated on Jun 9, 2019 at 01:37 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Jun 13, 2019 at 11:44 AM
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
Related:

1 response

Answer 1 / 1
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 13, 2019 at 11:44 AM
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
0