Macro to insert rows and autofill

[anglais428]

Hi Guys,

I'm looking to see if it is possible to create a Macro that will insert 38 rows after each cell in my list of countries, then autofill down the empty rows with the country name so that each country will go from appearing once to appearing 38 times. For example:

My initial list is say (in cells A1,A2,A3):

Argentina
Australia
UK

In the end I want it to say Argentina 38 times (from cell A1:A38), then Australia 38 times (cell A39:A77) then UK 38 times( cell A78:A116)

Is this possible?

I have this Macro to insert rows but I don't know anything about coding so cannot modify it to replicate the names

Sub AddRows()
Dim lastrow As Long, cell As Range, i As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastrow To 1 Step -1
Set cell = Cells(i, 1)
cell.Offset(1, 0).Resize(38, 1).EntireRow.Insert
Next
End Sub

Many thanks,

 

[nigelk]

Maybe something along these lines?

Sub Macro1()
Dim CRange As Range
Rows("2:38").Insert Shift:=xlDown
Set CRange = Range(Cells(2, 1), Cells(38, 1))
Range("a1").Copy Destination:=CRange
Rows("40:76").Insert Shift:=xlDown
Set CRange = Range(Cells(40, 1), Cells(76, 1))
Range("a39").Copy Destination:=CRange
Set CRange = Range(Cells(78, 1), Cells(114, 1))
Range("a77").Copy Destination:=CRange
 
End Sub

 

[anglais428]

That is good for those three locations. However I have many locations (over 400) that I would like this to run for - is there anyway the code you provided can be built into a loop or something?

Thanks,

 

[nigelk]

Heres the best I could do, don't know how long it will take with over 400 rows though. It puts the results in Col B

Sub test()
Dim Countries As Long
Dim RowNum As Long
Dim CRange As Range
Dim X As Long
 
Countries = Sheets("sheet1").Range("A65536").End(xlUp).Row
 
For X = 1 To Countries
 
RowNum = Sheets("sheet1").Range("B65536").End(xlUp).Row
 
If X > 1 Then
RowNum = RowNum + 1
End If
 
Set CRange = Range(Cells(RowNum, 2), Cells(RowNum + 37, 2))
 
Cells(X, 1).Copy Destination:=CRange
 
Next
 
End Sub

Then you can just delete col A.

 

[anglais428]

Thanks alot NigelK, this works really well. Appreciate your help.