Quote Originally Posted by westconn1 View Post
i can only assume that the selection is not as expected for some reason, which i can not guess at
i always recommend to avoid selecting or activating anything and to as far as possible avoid working with the selection object or active anything

for any further assistance (not that you got any so far), i think you would need to post the vba code, or even attach a workbook (zip first) with some sample data and the macro
Thanks Westconn1 for your speedy reply. I use select and activate so I can see how my development is progressing as I am a step by step to getting things automated type of 'developer'. IT is not my main role. I use VB to automate regular tasks where possible and where time allows. Often once it's working I don't often get time to go back and clean it up. I also use it to show users what is happening as they run the macro during training (a sign of my insecurity or to assure users - probably a bit of both).

Apologies but the excel file doesn't appear to want to upload (even zipped it is 539kb). So here is the code (I have stated 'IT STOPS HERE ON ONE PERSONS COMPUTER. EVERYONE ELSE IT WORKS at the point where the error message occurs on the 'rouge' laptop).

Option Explicit
Sub CreateSendPO()
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
Dim outApp As Object
Set outApp = CreateObject("Outlook.Application")
Dim exApp As Object
Set exApp = CreateObject("Excel.Application")
Dim myDir As String
myDir = ActiveWorkbook.Path

With exApp
Dim poTo As String
poTo = Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("E5") & " PO dated " & Format(Now(), "yyyy-mm-dd hh-mm-ss") & ".docx"
End With

With wdApp
.Documents.Add
.Selection.PageSetup.Orientation = 1
.Visible = True
.Activate

Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Header").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)

Dim dat As Variant
Dim rng As Range
Dim i As Long
Dim val As String
Dim PO_rng As String

Set rng = Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Lines")
dat = rng
val = 1
For i = LBound(dat, 1) To UBound(dat, 1)

If dat(i, 1) <> "" Then
PO_rng = "PO_Line" & val
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range(PO_rng).CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
.Selection.ParagraphFormat.Spacebefore = 0
val = val + 1
Else
val = val + 1
End If
Next

Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Totals").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
.Selection.InsertBreak 'IT STOPS HERE ON ONE PERSONS COMPUTER. EVERYONE ELSE IT WORKS

If Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("B35") <> "" Then
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Virements").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
Else
GoTo skipvire
End If


Set rng = Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Vire_Lines")
dat = rng
val = 1
For i = LBound(dat, 1) To UBound(dat, 1)

If dat(i, 1) <> "" Then
PO_rng = "PO_Virements" & val
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range(PO_rng).CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
val = val + 1
End If
Next
.Selection.InsertBreak

skipvire:

If Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("New_Supplier_Req") = "Y" Then
Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_New_Supplier").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)
Else

End If

Workbooks("PR and Budget Opex 2018.xlsm").Sheets("Requisition").Range("PO_Sign_Off").CopyPicture Appearance:=xlScreen, Format:=xlPicture
.Selection.PasteAndFormat (13)


End With

ChDir "C:\Purchase Orders\"


With wdApp
.ActiveDocument.SaveAs2 fileName:="C:\Purchase Orders\" & poTo
.ActiveDocument.SendMail
End With

ChDir myDir

End Sub

Thanks
Mike