Create a copy of a existing worksheet / Saving the sheet as values only (as new file) / then emailing out

[DataMonkeyNo1]

Hi Fellow Excelians,

This is my first post on here so please be patient. I am currently trying to automate a report, I know the refresh and email out subs easily enough, but I've attempted to include a section to save over as new values, at which point I get

[h=1]"Run Time error '9' - Subscript out of range"[/h]
Below is the VBA I have been using (I have omitted some areas to XXX):

/VBA for copy over a worksheet to a new file (as values) THEN save the file to a specified location THEN to E-mail the file out to a specified group of people.


Private Sub Workbook_Open()


ActiveWorkbook.RefreshAll


Application.DisplayAlerts = False
Worksheets("Rpt").Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
Set wbNew = ActiveWorkbook
wbNew.SaveAs "XXX\Daily Stock Bible Sent Today.xls"
wbNew.Close True
Application.DisplayAlerts = True


Dim OutApp As Object
Dim OutMail As Object


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.to = "XXX"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "It Bloody Works"
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing

End Sub


Utmost thanks for anyone who spends any time in assisting me with this.

 

[Andrew Poulsom]

Which line is causing the error? If it's this one:

Worksheets("Rpt").Copy

make sure that you have a worksheet named Rpt in the workbook that contains your VBA code.

 

[jim may]

On what line are you getting the r/t error? It's helpful to know that! Jim

 

[JMonty]

Please try:

Private Sub WorkbookCopyAndSend()

    Dim Source, Target As Workbook
    Dim ReportS, ReportT As Worksheet

    Set Source = ActiveWorkbook
    Set Target = Workbooks.Add
    Set ReportS = Target.Sheets("Rpt")

    Source.RefreshAll

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    ReportS.Copy Before:=Target.Sheets(1)

    With Target
        .Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
        Set ReportT = .Sheets("Rpt")
        With ReportT.UsedRange
            .Copy
            .PasteSpecial xlPasteValues
        End With
        .SaveAs "XXX\Daily Stock Bible Sent Today.xls"
        .Close
    End With

    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        .To = "XXX"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "It Bloody Works"
        .Attachments.Add Target.FullName
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Let us know if this works.

Thanks,

J.