VBA to copy column headers and insert multiple times in rows

[anglais428]

Hi,

I am looking to convert this:

Section\ Year	1	2	3	4	5
A

<tbody>
</tbody>

by a specific value (say 2 for example) into:

Section	Yr
A	1
A	1
A	2
A	2
A	3
A	3
A	4
A	4
A	5
A	5

<tbody>
</tbody>

I already have something working for the "sections" it is more for the years which are original across the columns and I would like them to be in 1 column for multiple rows.

Thanks,

 

[iliauk]

I wasn't too sure what you wanted but maybe we can work from the below?

Dim Repeat As Long
Dim rLastCell As Range
Dim lColumn As Long
Dim i As Long
'How many times to copy
Repeat = 3


Set rLastCell = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
lColumn = rLastCell.Column


For i = 1 To (lColumn - 1)
Range("B" & 2 + ((i - 1) * Repeat)).Resize(Repeat).Value = Cells(1, i + 1)
Next
Range("A2").Resize((i - 1) * Repeat) = "A"

 

[anglais428]

This is almost exactly what I need. What I actually need (and it wasn't in my original post) was to ignore a column that is between the "section/year" and "2000". How can I tinker the code to only take into account the last 5 (out of 7) column headers?

many thanks

 

[iliauk]

Ah I see.

I have added a new variable called Start that determines the column we start with.

Dim Repeat As Long
Dim Start As Long
Dim lColumn As Long
Dim i As Long
'How many times to copy
Repeat = 6
'Which column to start with
Start = 2
'Which column to end with
lColumn = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column


For i = 1 To (lColumn - 1)
Range("B" & 2 + ((i - 1) * Repeat)).Resize(Repeat).Value = Cells(1, i + Start)
Next
Range("A2").Resize((i - Start) * Repeat) = "A"

 

[anglais428]

Perfect! Thanks very much.