Move unknown number of headings into cells in new columns

Hi,

I have a sheet with a list of transactions. The headings for each account is listed above the transactions. In order to create a list, I need to move each heading to its own new column on each transaction line. These could be the headings:

Account
S3
S4
G1
G2

They are following by a number of transactions, each in a separate row. All transaction rows need to contain the headings for that specific account.

I have figured out how to make it work when there are 5 headings, however, if my colleagues should also benefit from this macro, it needs to be changed so that there can be between 5 and 8 headings.

I have also figured out how to create the right number of new columns, but I struggle with copying the headings to the cells in the new columns. This is the way I have done it when knowing the number of headings:

For w = 1 To Cells.SpecialCells(xlLastCell).Row Step 1

    'Find first row in column F with the value Account
    Set soeg = Columns("F").Find(What:="Account", After:=Range("F1"), LookIn:=xlFormulas _ 
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
    If Not soeg Is Nothing Then
    
    soeg.Activate
    konto = ActiveCell.Row 'Row number containing the account heading
    s3 = konto + 1 'Row number containing the S3 heading
    s4 = konto + 2 'Row number containing the S4 heading
    g1 = konto + 3 'Row number containing the G1 heading
    g2 = konto + 4 'Row number containing the G2 heading
    postering = konto + 5 'Row number of the first transaction
    Columns("F").Find(What:="", After:=Cells(postering, 6), LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    tom_celle = ActiveCell.Row 'Row number of empty row following the last transaction
    sidste_postering = tom_celle - 1 'Row number of last transaction
        
    start = postering
        
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    
    For p = start To sidste_postering Step 1
    
    'For each transaction line copy the right heading to the right cell in the new column
    WS.Cells(postering, 1).Value = ActiveSheet.Cells(konto, 7).Value
    WS.Cells(postering, 2).Value = ActiveSheet.Cells(s3, 7).Value
    WS.Cells(postering, 3).Value = ActiveSheet.Cells(s4, 7).Value
    WS.Cells(postering, 4).Value = ActiveSheet.Cells(g1, 7).Value
    WS.Cells(postering, 5).Value = ActiveSheet.Cells(g2, 7).Value
    postering = postering + 1
    
    Next p

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    End If

Next w

How do I do this when I do not know the number of headings?

Best regards,
LKottal