Offest and copy down till last row

[silentwolf]

Hi guys,
its been a while since I needet Excel VBA so I get a little rusty again on some topics.

I have a price list I need to update.

In Column A are different amount of Categories like Headers..

Header 1
Header 2
Header 3

Then below of that ItemNumbers

As the Headers are not always the same amount I was wondering how I can get the headers over to another column for example
Find first empty cell in Column D, Offset to the left and get the value of that Header..

Sub Test()
Application.ScreenUpdating = False
Dim c  As Range
    For Each c In Range("D2:D" & Cells(rows.Count, "A").End(xlUp).row)
        Dim strT As String
        
        If c.Value = "" Then c.Offset(, 4).Value = c.Offset(, -3).Value
        
    Next
Application.ScreenUpdating = True
End Sub

Above there is the code for that which I found very simalar here from My Aswer is This!

However how would I need to change that code so after the first loop offset the one less .. If c.Value = "" Then c.Offset(, 3).Value = c.Offset(, -3).Value
and do so until there is no more header and then continou with the code and do the same for the next Header is found.


So it is kind of cascading and I get all heaers into a different Column.

Hope someone could help me with this please?

Many thanks

Great would be to copy each header down till the last Row it would then overright the existing with the new header.

 

[silentwolf]

Have an update but maybe someone can tell me how to reset the j Counter once it finds no more empty cell and start over again when the next
headers are found.

At present the code runs only for the first few headers and then continous to subrtuct one so it keeps going to the left which of course is not right.

Sub TestNumberTwo()
Application.ScreenUpdating = False
Dim j As Long
j = 0

Dim c  As Range
    For Each c In Range("D2:D" & Cells(rows.Count, "A").End(xlUp).row)
        If c.Value = "" Then c.Offset(, 4 + j).Value = c.Offset(, -3).Value
        j = j - 1
    Next
Application.ScreenUpdating = True
End Sub