If you change the line to
Application.Templates( _
Environ("APPDATA") & "\Microsoft\Document Building Blocks\1033\" & Val(Application.Version) & "\Built-In Building Blocks.dotx" _
).BuildingBlockEntries("Bold Numbers 3").Insert _
Where:=Selection.Range, _
RichText:=True
It will be transportable. You could however create the same effect with a simpler code
Sub PageNumbers2()
Dim oRng As Range
Set oRng = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
Application.Templates(Environ("APPDATA") & "\Microsoft\Document Building Blocks\1033\" & _
Val(Application.Version) & _
"\Built-In Building Blocks.dotx").BuildingBlockEntries("Bold Numbers 3").Insert _
Where:=oRng, RichText:=True
End Sub