Sir where in this code i will adjust ? i will add another column ?

sample.png



Sub Jasond1992()
    
    Application.ScreenUpdating = False
    
    Dim WS As Worksheet, LR As Integer, Counter As Integer, NewWS As Worksheet, LR2 As Integer, CopyCount As Integer, LC As Byte, SHName As String, FC As Integer
    
    Set WS = ActiveSheet
    
    If WS.Range("A1") = "" Then FC = WS.Range("A1").End(xlDown).Row Else FC = 1
    
    SHName = WS.Name
    Set NewWS = Sheets.Add
    
    WS.Rows(FC & ":" & FC).Copy ActiveSheet.Cells(FC, 1)
    
    LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
    LC = WS.Cells(FC, Columns.Count).End(xlToLeft).Column
    
    For Counter = FC + 1 To LR
        LR2 = NewWS.Cells(Rows.Count, 1).End(xlUp).Row + 1
        CopyCount = WS.Cells(Counter, LC).Value
        WS.Select
        WS.Range(Cells(Counter, 1), Cells(Counter, LC)).Copy NewWS.Cells(LR2, 1)
        NewWS.Select
        NewWS.Range(Cells(LR2, 1), Cells(LR2 + CopyCount, LC)).FillDown
    Next Counter
    
    Cells(FC + 1, 1).Value = 1
    Cells(FC + 2, 1).Value = 2
    Range("A" & FC + 1 & ":A" & FC + 2).AutoFill Destination:=Range("A" & FC + 1 & ":A" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    Range("F" & FC + 1 & ":F" & Cells(Rows.Count, 1).End(xlUp).Row).Value = 1
    
    Application.DisplayAlerts = False
    NewWS.Cells.EntireColumn.AutoFit
    NewWS.Cells.EntireRow.AutoFit
    Sheets(SHName).Delete
    NewWS.Name = SHName
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
End Sub