Excel/Question Again


i copied just as you wrote it and didn't make any changes, the following happened:

i run the Sub PrintMasterInvoice()

it first asks me whether to save as a macro free workbook, if i select yes then it acts like its doing something in the back ground but the following code is highlighted in yellow
as follows:

Sub Sendmonthlystatement1()

Workbook.Open strPath & "MultipleSheets.xlsx"

if i select no its starts creating a workbook of the sheets, following code is highlighted in  yellow as follows:

Sub PrintMasterInvoice()

bk3.SaveAs Filename:=strPath & "MultipleSheets.xlsx", FileFormat:=xlOpenXMLWorkbook

after which i noticed there is a book1 created, with monthlystatement1 worksheets, for the five clients, as follows:

Sendmonthlystatement1 (1)
Sendmonthlystatement1 (2)
Sendmonthlystatement1 (3)
Sendmonthlystatement1 (4)
Sendmonthlystatement1 (5)

but neither one creates nor starts an outlook application...




--- revised one line.  Use this cod

when I create the workbook it has no vba code in it.  Just copying sheets to it does not create code in the workbook unless the sheets contain code. So I suspect your monthlystatement contains code.

If that is the case, here is the revised code:

Option Private Module

Sub PrintMasterInvoice()

Application.ScreenUpdating = False

Dim ce As Range, i As Long, strPath As String
Dim bk1 As Workbook, bk2 As Workbook
Dim Sh1 As Worksheet, sh2 As Worksheet, Sh3 As Worksheet

Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range
Dim r8 As Range, r9 As Range, r10 As Range, r11 As Range, r12 As Range, r13 As Range, r14 As Range
Dim r15 As Range, r16 As Range, r17 As Range, r18 As Range, r19 As Range, r20 As Range, r21 As Range
Dim r22 As Range, r23 As Range, r24 As Range, r25 As Range

Dim s1 As Range, s2 As Range, s3 As Range, s4 As Range, s5 As Range, s6 As Range, s7 As Range
Dim s8 As Range, s9 As Range, s10 As Range, s11 As Range, s12 As Range, s13 As Range, s14 As Range
Dim s15 As Range, s16 As Range, s17 As Range, s18 As Range, s19 As Range, s20 As Range, s21 As Range
Dim s22 As Range, s23 As Range, s24 As Range, s25 As Range

Set bk1 = ThisWorkbook
Workbooks.Add Template:=xlWBATWorksheet
Set bk3 = ActiveWorkbook
Set Sh3 = bk3.Worksheets(1)
bk1.Sheets("pymtlog").Visible = True
bk1.Sheets("monthlystatement1").Visible = True

' define your sheets outside the loop
Set Sh1 = bk1.Worksheets("pymtlog") '<== Moved
Set sh2 = bk1.Worksheets("monthlystatement1") '<== Moved
lOrders = Sh1.Range("C3").Value
' you find the bottom of your data using row M

For i = 8 To Sh1.Range("B65536").End(xlUp).Row

' but your check for your value in column "I"
' if that is correct OK. But if you want to check in ' column M change your 9 to "M" or 13

If ((Sh1.Cells(i, 2).Value = Sh1.Range("A3"))) Then

Set r1 = Sh1.Cells(i, "E") 'Account #
Set r2 = Sh1.Cells(i, "D") 'Name
Set r3 = Sh1.Cells(i, "Z") 'Address
Set r4 = Sh1.Cells(i, "ASE") ' City, St Zip
Set r5 = Sh1.Cells(i, "O") ' Home #
Set r6 = Sh1.Cells(i, "M") ' Cell #
Set r7 = Sh1.Cells(i, "P") ' Email Addy
Set r8 = Sh1.Cells(i, "AE") ' Date Closed
Set r9 = Sh1.Cells(i, "AK") ' Payment
Set r10 = Sh1.Cells(i, "AJ") ' Terms
Set r11 = Sh1.Cells(i, "AI") ' Rate
Set r12 = Sh1.Cells(i, "AL") ' 1st Pymt
Set r13 = Sh1.Cells(i, "ASD") ' Balance
Set r14 = Sh1.Cells(i, "ASF") ' Last Paid

Set r15 = Sh1.Cells(i, "ASG") ' Amt Paid
Set r16 = Sh1.Cells(i, "ASH") ' Months Left
Set r17 = Sh1.Cells(i, "AQ") ' Year
Set r18 = Sh1.Cells(i, "AP") ' Make
Set r19 = Sh1.Cells(i, "AS") ' Serial Number

Set r20 = Sh1.Cells(i, "ASJ") ' Applied to Interest
Set r21 = Sh1.Cells(i, "ASK") ' Applied to Principal
Set r22 = Sh1.Cells(i, "ASD") ' Current Balance
Set r23 = Sh1.Cells(i, "ASI") ' Next Date Due
Set r24 = Sh1.Cells(i, "AK") ' Amount Due
Set r25 = Sh1.Cells(i, "ASL") ' Months Past Due

Set s1 = sh2.Range("M1") 'Account #
Set s2 = sh2.Range("M2") 'Name
Set s3 = sh2.Range("M3") 'Address
Set s4 = sh2.Range("M4") ' City, St Zip
Set s5 = sh2.Range("M5") ' Home #
Set s6 = sh2.Range("M6") ' Cell #
Set s7 = sh2.Range("M7") ' Email Addy
Set s8 = sh2.Range("M8") ' Date Closed
Set s9 = sh2.Range("M9") ' Payment
Set s10 = sh2.Range("M10") ' Terms
Set s11 = sh2.Range("M11") ' Rate
Set s12 = sh2.Range("M12") ' 1st Pymt
Set s13 = sh2.Range("M13") ' Balance
Set s14 = sh2.Range("O1") ' Last Paid

Set s15 = sh2.Range("O2") ' Amt Paid
Set s16 = sh2.Range("O3") ' Months Left
Set s17 = sh2.Range("O4") ' Year
Set s18 = sh2.Range("O5") ' Make
Set s19 = sh2.Range("O6") ' Serial Number

Set s20 = sh2.Range("O7") ' Applied to Interest
Set s21 = sh2.Range("O8") ' Applied to Principal
Set s22 = sh2.Range("O9") ' Current Balance
Set s23 = sh2.Range("O10") ' Next Date Due
Set s24 = sh2.Range("O11") ' Amount Due
Set s25 = sh2.Range("O14") ' Months Past Due

s1.Value = r1.Value
s2.Value = r2.Value
s3.Value = r3.Value
s4.Value = r4.Value
s5.Value = r5.Value
s6.Value = r6.Value
s7.Value = r7.Value
s8.Value = r8.Value
s9.Value = r9.Value

s10.Value = r10.Value
s11.Value = r11.Value
s12.Value = r12.Value
s13.Value = r13.Value
s14.Value = r14.Value

s15.Value = r15.Value
s16.Value = r16.Value
s17.Value = r17.Value
s18.Value = r18.Value
s19.Value = r19.Value
s20.Value = r20.Value
s21.Value = r21.Value
s22.Value = r22.Value
s23.Value = r23.Value
s24.Value = r24.Value
s25.Value = r25.Value

'ChDir "C:UsersAnthonyDesktop"
'Sh2.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard

' since I reference sh2 directly, I don't have ' to hide sh1 and then show it again sh2.Printout

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=strPDFprinter, Collate:=-True
sh2.Copy After:=bk3.Worksheets(bk3.Worksheets.Count)
End If

Next i '<== added command
sh2.Visible = xlSheetHidden
Set Sh1 = Nothing
Set sh2 = Nothing
strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
On Error Resume Next
 Kill strPath & "MultipleSheets.xlsx"
On Error GoTo 0
bk3.SaveAs Filename:=strPath & "MultipleSheets.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
bk3.Close SaveChanges:=False

MsgBox " Total of " & lOrders & " Monthly Statements" & vbNewLine & _
" Were Successfully Prepared and Copied"

' call routine to prepare and send out PDF attachment


Worksheets("monthlystatement1").Visible = xlSheetVeryHidden

Application.ScreenUpdating = True

End Sub

Sub Sendmonthlystatement1()
' Create PDF of active sheet and send as attachment.

Sheets("monthlystatement1").Visible = True
Worksheets("pymtlog").Visible = xlSheetVeryHidden

Dim Sh1 As Worksheet
Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object
Dim bk1 As Workbook, bk2 As Workbook
Dim sh2 As Worksheet

Set bk1 = ThisWorkbook

'Create PDF of active sheet only
strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"
Workbooks.Open strPath & "MultipleSheets.xlsm"
Set bk2 = Workbooks("Multiplesheets.xlsm")

'Set up outlook
Set OutApp = CreateObject("Outlook.Application")
For Each sh2 In bk2.Worksheets
Set Sh1 = sh2
strFName = Sh1.Range("D10")
strFName = "Monthly Statement" & " - " & "" & ".pdf"
strEname = Sh1.Range("D14")
strOName = Sh1.Range("G20")
strOCName = Sh1.Range("B1")
strCCName = Sh1.Range("A14")
On Error Resume Next
  Kill strPath & strFName
On Error GoTo 0

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Set OutMail = OutApp.CreateItem(0)
'Create message
On Error Resume Next

With OutMail
.To = strEname 'Insert required address here ########
.CC = strCCName
.BCC = ""
.Subject = "Monthly Statement"
.Body = vbNewLine & vbNewLine & _
"Attached is your Monthly Statement for your review." & vbNewLine & vbNewLine & _
"If you have any question feel free to call. " & vbNewLine & vbNewLine & _
"Thanks!" & vbNewLine & vbNewLine & _
"Management" & vbNewLine '& _
'strOCName & vbNewLine
.Attachments.Add strPath & strFName
.Display 'Use only during debugging ##############################
'.Send 'Uncomment to send e-mail ##############################
End With
'Delete any temp files created
Kill strPath & strFName
On Error GoTo 0
Set OutMail = Nothing
Next sh2

bk2.Close SaveChanges:=False
Set OutApp = Nothing

Sheets("pymtrecpt").Visible = True
'Worksheets("pymtlog").Visible = xlSheetVeryHidden

Application.ScreenUpdating = True

End Sub

Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Tom Ogilvy


Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]


Extensive experience.

Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2017 About.com. All rights reserved.