Want to add additional columns to attached macro please

Option Explicit
Sub ListTraining()
    Dim LastRow As Long, i As Long, StartRow As Long, NameCol As Integer
    Dim ISh As Worksheet, OSh As Worksheet, j As Long
    StartRow = 2
    NameCol = 1
    Set ISh = ActiveSheet
    LastRow = ISh.Cells(Rows.Count, NameCol).End(xlUp).Row
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Need Training").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Need Training"
    Set OSh = Sheets("Need Training")
    OSh.Cells(1, 1).Value = "Training overdue for Manual Handling"
    'Want to add an extra four columns. The titles of columns can be col2, col3, col4 and col6.
    OSh.Cells(1, 2).Value = "col2"
    OSh.Cells(1, 3).Value = "col3"
    OSh.Cells(1, 4).Value = "col4"
    OSh.Cells(1, 5).Value = "col6"
    j = 1
    For i = StartRow To LastRow
        If IsEmpty(ISh.Cells(i, NameCol + 1).Value) Then
            j = j + 1
            OSh.Cells(j, 1).Value = ISh.Cells(i, NameCol).Value
        End If
    Next i
    OSh.Columns(1).EntireColumn.AutoFit
End Sub