Add to Make a String

[brettdj]

You dont want to be looping

This code doesn't check for input or source length & type. Do you want that?

Sub ConA()
    Dim Myrange As Range, Mystr As String
    Application.ScreenUpdating = False
Mystr = InputBox("Enter the 6 number string to be appended to Column A")
Set Myrange = ActiveSheet.Range(ActiveSheet.Range("A2"), ActiveSheet.Range("A65536").End(xlUp))
    Set Myrange = Intersect(Myrange, ActiveSheet.Cells.SpecialCells(xlConstants))
With Myrange
    .Offset(0, 1).Columns.Insert
    .Offset(0, 1).FormulaR1C1 = "=Concatenate(RC[-1], """ & Mystr & """)"
    .Offset(0, 1).FormulaR1C1Local = .Offset(0, 1).Value
    .Columns.Delete
    End With
Application.ScreenUpdating = True
End Sub