P
PhilosophersSage
Form Print Macro
I was given a workbook in which Sheets 1-4 are forms and have formulas
referring to sheet 5 which contains the data. I had to update the forms for a
new FY format and now the macro crashes XL.
Sub Printer()
'
' Printer Macro
' Keyboard Shortcut: Ctrl+p
'
Sheets("ATTACHMENT A").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="3", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="4", Replacement:="5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
..
..
..
Sheets("ATTACHMENT B").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="3", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="4", Replacement:="5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
The macro continues through the rest of the forms and rows
I want to optimize the code so it collates the forms together and if
possible send one print job to printer so I can use printer binging
functions. Also would like to do a test for last row in data so I don’t have
to hardcode lines(but don’t know how to achieve) Here is what I have but
cannot figure out where to go from here… Please help
Sub Printer()
Dim org(3) As Integer 'starting row 3 for print
Dim nxt As Integer 'next row to print
Dim Count As Integer 'Counter
Application.ScreenUpdating = False
For Count = 1 To 34 ‘need to change to test for last row
nxt = org + 1
Sheets("SHEET1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET2").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET3").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET4").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
org = org + 1
Next Count
‘need to reset back to 3
Application.ScreenUpdating = True
End Sub
I was given a workbook in which Sheets 1-4 are forms and have formulas
referring to sheet 5 which contains the data. I had to update the forms for a
new FY format and now the macro crashes XL.
Sub Printer()
'
' Printer Macro
' Keyboard Shortcut: Ctrl+p
'
Sheets("ATTACHMENT A").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="3", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="4", Replacement:="5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
..
..
..
Sheets("ATTACHMENT B").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="3", Replacement:="4", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:="4", Replacement:="5", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
The macro continues through the rest of the forms and rows
I want to optimize the code so it collates the forms together and if
possible send one print job to printer so I can use printer binging
functions. Also would like to do a test for last row in data so I don’t have
to hardcode lines(but don’t know how to achieve) Here is what I have but
cannot figure out where to go from here… Please help
Sub Printer()
Dim org(3) As Integer 'starting row 3 for print
Dim nxt As Integer 'next row to print
Dim Count As Integer 'Counter
Application.ScreenUpdating = False
For Count = 1 To 34 ‘need to change to test for last row
nxt = org + 1
Sheets("SHEET1").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET2").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET3").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
Sheets("SHEET4").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Cells.Replace What:=org, Replacement:=nxt, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False,
ReplaceFormat:=False
org = org + 1
Next Count
‘need to reset back to 3
Application.ScreenUpdating = True
End Sub