Creating Macro but cannot get vb code modified

I have created a macro that should copy the contents of cell A1 and then paste it into the 10 shapes.  What appears in the macro is it has stored a static value and copies the same text into the shapes no matter what I put in Cell A1.  Could someone help me get this working.  Feeling so defeated right now.  Below is the code from the macro.

Sub CreateBlocks()
'
' CreateBlocks Macro
' CreateBlocks
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "454545"
    ActiveSheet.Shapes.Range(Array("TextBox 111")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 564")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 565")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 566")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 567")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 568")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 569")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 570")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 571")).Select
    ActiveSheet.Shapes.Range(Array("TextBox 572")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "454545"
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 6).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 36
        .Name = "+mn-lt"
    End With
    Range("A2").Select
End Sub