kjp2u,

The following macro should accomplish what you're looking for:
Sub Copy_SPM_Extract()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim wsSource As Worksheet:  Set wsSource = Sheets("SPM PIR extract")
    Dim wsDest As Worksheet:    Set wsDest = Sheets("PIR Winshuttle template")
    Dim wsPlants As Worksheet:  Set wsPlants = Sheets("Plants")
    Dim NumberOfPlants As Long: NumberOfPlants = wsPlants.Range("A" & Rows.Count).End(xlUp).Row
    Dim LastItem As Long:       LastItem = wsSource.Range("A" & Rows.Count).End(xlUp).Row
    Dim ThisPlant As Long:      ThisPlant = 1
    Dim ThisData As Long:       ThisData = 2
    Dim rngDataLine As Range, DataCell As Range
    
    Application.CutCopyMode = False
    wsSource.Range("A1:J1").Copy
    wsDest.Range("A1").PasteSpecial xlPasteAll
    wsDest.Range("A1").PasteSpecial xlPasteColumnWidths
    wsDest.Range("A1").Value = "VENDOR"
    Application.CutCopyMode = False
    
    While ThisData <= LastItem
        Set rngDataLine = wsSource.Range("A" & ThisData & ":J" & ThisData)
        ThisPlant = 1
        While ThisPlant <= NumberOfPlants
            For Each DataCell In rngDataLine
                If DataCell.Column = 3 Then
                    wsDest.Cells(Rows.Count, DataCell.Column).End(xlUp).Offset(1, 0).Value = "A300"
                ElseIf DataCell.Column = 4 Then
                    wsDest.Cells(Rows.Count, DataCell.Column).End(xlUp).Offset(1, 0).Value = wsPlants.Range("A" & ThisPlant).Value
                Else
                    wsDest.Cells(Rows.Count, DataCell.Column).End(xlUp).Offset(1, 0).Value = DataCell.Value
                End If
            Next DataCell
            ThisPlant = ThisPlant + 1
        Wend
        ThisData = ThisData + 1
    Wend
    
    wsDest.Activate
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub


Hope that helps,
~tigeravatar