Pfthb

edit
The purpose of this project was to use 1 application to list off a single customer and anywhere from 1-100 serial numbers with barcodes. The data that is in the spreadsheet would then populate a word document (via command button) populate the appropriate sections and print.

I hope this makes things a little more clear.

I am trying to figure out a way to create an excel spreadsheet that contains all of the information and with a command button send the data to word and populate all of the designated spots.

I will include some photos for reference, I did not include all of the serial number/ barcode code because it is the exact same code repeated multiple times.

Sub ReplaceText()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("Word.Application")
wApp.Visible = True

Set wDoc = wApp.Documents.Add("This is my file name", , False)

With wDoc
 .Application.Selection.Find.Text = "<<Customer>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("A2")

 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Assembly>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("B2")
 .Application.Selection.EndOf


 .Application.Selection.Find.Text = "<<PO>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("C2")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Quantity>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("D2")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<SerialNumber>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("E2")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Barcode>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("F2")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<SerialNumber>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("E3")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Barcode>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("F3")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<SerialNumber>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("E4")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Barcode>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("F4")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<SerialNumber>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("E5")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Barcode>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("F5")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<SerialNumber>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("E6")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Barcode>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("F6")
 .Application.Selection.EndOf


 .Application.Selection.Find.Text = "<<SerialNumber>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("E7")
 .Application.Selection.EndOf

 .Application.Selection.Find.Text = "<<Barcode>>"
 .Application.Selection.Find.Execute
 .Application.Selection = Range("F7")
 .Application.Selection.EndOf



 .SaveAs2 Filename:=("file name goes here"), _
 FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
End With

End Sub

This is the word document that I want to transfer all the data to. It is a template.

This is the excel data that I want to transfer

Edited to add an option to replace all matching token instances, or only one.
For repeated tokens, this allows you to replace one at a time, using different values.

It's not clear what your barcodes are (font? graphic?) but you can likely follow the same approach as for the serial numbers.

NOTE - it's not clear to me that the order of replacements in the serialnumber-Barcode pairs will always be in sync: you will need to test to verify.

Sub PerformReplacements()

 Dim wApp As Word.Application
 Dim wDoc As Word.Document, c As Range

 Set wApp = CreateObject("Word.Application")
 wApp.Visible = True

 Set wDoc = wApp.Documents.Open("C:UserstwilliamsDesktoptmp.docx", , False)

 ReplaceToken wDoc, "<<Customer>>", Range("A2").Value
 ReplaceToken wDoc, "<<Assembly>>", Range("B2").Value

 'serialnumbers
 For Each c In Range("E2:E10").Cells
 If c.Value <> "" Then
 ReplaceToken wDoc, "<<SerialNumber>>", c.Value, False '<< one replacement only
 End If
 Next c

 wDoc.SaveAs2 Filename:="C:UserstwilliamsDesktoptmp2.docx", _
 FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False

End Sub

'given a document and a token to replace, replace only one or all of the
' token instances with "newText"
Sub ReplaceToken(doc As Word.Document, token As String, newText As String, _
 Optional replaceAll As Boolean = True)

 doc.Application.Options.DefaultHighlightColorIndex = wdNoHighlight
 With doc.Range.Find
 .Text = token
 .replacement.Text = newText
 .replacement.ClearFormatting
 .replacement.Font.Italic = False
 .Forward = True
 .Wrap = wdFindContinue
 .Format = False
 .MatchCase = False
 .MatchWholeWord = True
 .MatchWildcards = False
 .MatchSoundsLike = False
 .MatchAllWordForms = False
 .Execute Replace:=IIf(replaceAll, wdReplaceAll, wdReplaceOne) '<<<<<edit
 End With

End Sub

Note - it would be easier to manage this process if your worksheet also had the token names: you could then loop over the range and perform the replacements without having to hard-code the tokens into your VBA.