Sub CRL_FIX()
' Fix the SUP/WRK and Telephone data
'
lr = Application.Max(2, Cells(Rows.Count, "A").End(xlUp).Row)
Columns("C:C").Insert
With Range("C2:C" & lr)
  .FormulaR1C1 = "=(RC[-2]&RC[-1])"
  .Value = .Value
End With
Range("C1").Value = "CHGEWRK"

With Range("AI2:AI" & lr)
  .FormulaR1C1 = "=(LEFT(RC[-1],3)&""-""&MID(RC[-1],4,3)&""-""&RIGHT(RC[-1],4))"
  .Value = .Value
End With
Range("AI1").Value = "TELEPHONE"
Columns("AH:AH").Delete
End Sub