looping through columns to find a value then replace said value with column header

Hello Forum,

I have a worksheet with values from column A to AK, and an undetermined number of rows yet.

I need a code to do this : loop through columns B to AK, and, for each cell containing the value 1, then replace 1 with the header of the column in which the cell containing 1 is... (Headers are on the first row).

I know how to do so but only with one column. Can you help me improve my code?

Thank you so much in advance.

Sub Loop_Column()

Dim rngCell As Range

For Each rngCell In ActiveSheet.Range("d:d")
    If rngCell.Value = 1 Then
         rngCell.Value = Range("d1").Value
    End If
    
  Next rngCell
End Sub

Awesome!

Thank you Mumps1!

Star symbol clicked!

I think to fully answer the question you may need the below amendment

Sub InsertHeader()
    Application.ScreenUpdating = False
    Dim x As Long
    For x = 2 To 37
        Columns(x).Replace "1", Cells(1, x), xlWhole
    Next x
    Application.ScreenUpdating = True
End Sub

as 10 or 11 etc will be changed by the first bit of code

Good point davsth, but I have only "1" in my spreadsheet. The other values are null or text.

Thank you anyway for the hint.