need help with macro for 400 worksheets!
 

I need to change the formatting, enter a few simple math formulas, an
password protect 400 documents. What I'm trying to accomlish is to b
able to run the macro for all the documents without having to open eac
one and perform the macro. i'll have all of them saved in on
directory.

the other issue is although each file will have the exact same amout o
columns, the amount of rows will not always be the same. And I need t
have a couple SUM formulas after the last row of each worksheet.

here is the vba code of the macro.

If there is any more explanation needed, please let me know.

I'm under pressure here at work to try and get this done...the previou
employee left on short notice and now i'm cleaning up the pieces. fun!


Thanks in advance for any guideance!



Code
-------------------
Sub Merit01()
'
' Merit01 Macro
' Macro recorded 4/4/2006 by xsxf8cq
'
' Keyboard Shortcut: Ctrl+Shift+M
'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
Columns("D:D").Select
Selection.NumberFormat = "#,##0.00"
Columns("H:H").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("L:L").Select
Selection.NumberFormat = "#,##0.00"
ActiveWindow.LargeScroll ToRight:=1
Range("Q:Q,S:S").Select
Range("S1").Activate
Selection.NumberFormat = "#,##0.00"
Columns("R:R").Select
Selection.NumberFormat = "0.00"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=(RC[-1]/RC[-14])*100"
Range("R3").Select
ActiveWindow.SmallScroll ToRight:=6
Range("R2").Select
Selection.Copy
Range("R3:R29").Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=-1
Range("D29").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
Range("D30").Select
ActiveWindow.LargeScroll ToRight:=1
Range("Q29").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-2],RC[-15])"
Range("S2").Select
Selection.Copy
Range("S3:S28").Select
ActiveSheet.Paste
Cells.Select
Range("E1").Activate
Selection.Columns.AutoFit
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Protect Structu=True, Windows:=False
End Su
-------------------

--
flyers2thecu
-----------------------------------------------------------------------
flyers2thecup's Profile: http://www.excelforum.com/member.php...fo&userid=1216
View this thread: http://www.excelforum.com/showthread.php?threadid=52970

need help with macro for 400 worksheets!
 

We suggest you try looping through the files using Dir( ) and call Merit01
within the loop thus

get first filename - dir()
start of loop
open first file
call Merit01
close activeworkbook
get next filename - dir
loop back

the last blank cell for the formula for column D would be
cells(rows.count,4).end(xlup)(2)

Regards

"flyers2thecup"
wrote in message
news:flyers2thecup.25r2az_1144170903.5673@excelfor um-nospam.com...

I need to change the formatting, enter a few simple math formulas, and
password protect 400 documents. What I'm trying to accomlish is to be
able to run the macro for all the documents without having to open each
one and perform the macro. i'll have all of them saved in one
directory.

the other issue is although each file will have the exact same amout of
columns, the amount of rows will not always be the same. And I need to
have a couple SUM formulas after the last row of each worksheet.

here is the vba code of the macro.

If there is any more explanation needed, please let me know.

I'm under pressure here at work to try and get this done...the previous
employee left on short notice and now i'm cleaning up the pieces. fun!


Thanks in advance for any guideance!



Code:
--------------------
Sub Merit01()
'
' Merit01 Macro
' Macro recorded 4/4/2006 by xsxf8cq
'
' Keyboard Shortcut: Ctrl+Shift+M
'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
Columns("D:D").Select
Selection.NumberFormat = "#,##0.00"
Columns("H:H").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Columns("L:L").Select
Selection.NumberFormat = "#,##0.00"
ActiveWindow.LargeScroll ToRight:=1
Range("Q:Q,S:S").Select
Range("S1").Activate
Selection.NumberFormat = "#,##0.00"
Columns("R:R").Select
Selection.NumberFormat = "0.00"
Range("R2").Select
ActiveCell.FormulaR1C1 = "=(RC[-1]/RC[-14])*100"
Range("R3").Select
ActiveWindow.SmallScroll ToRight:=6
Range("R2").Select
Selection.Copy
Range("R3:R29").Select
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=-1
Range("D29").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
Range("D30").Select
ActiveWindow.LargeScroll ToRight:=1
Range("Q29").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-27]C:R[-1]C)"
Range("S2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-2],RC[-15])"
Range("S2").Select
Selection.Copy
Range("S3:S28").Select
ActiveSheet.Paste
Cells.Select
Range("E1").Activate
Selection.Columns.AutoFit
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Protect Structu=True, Windows:=False
End Sub
--------------------


--
flyers2thecup
------------------------------------------------------------------------
flyers2thecup's Profile:
http://www.excelforum.com/member.php...o&userid=12166
View this thread: http://www.excelforum.com/showthread...hreadid=529709

need help with macro for 400 worksheets!
 

Hi

I agree with PY & Associates that looping through the files is the way
to go & the suggestion for identifying the last row.

I've made some changes to your macro which should speed it up (based on
the fact that the fewer dots used the better) & have added some
explanatory comments with a prefix of "'*":


Code:
--------------------
Sub Merit01()
' Keyboard Shortcut: Ctrl+Shift+M
Application.ScreenUpdating = False
Dim LastRow As Long
'*same concept as other post but uses column A to find last row
LastRow = Cells(rows.Count, "A").End(xlUp).Row

'* have left the page setup code as I'm not sure which lines are actually _
needed. FYI, any lines that are the default values should be safe to delete.
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 100
End With
'* have limited to this range to help keep file size down.
Range("D1:D" & LastRow & ",L1:L" & LastRow & ",Q1:Q" & LastRow & ",S1:S" & LastRow).NumberFormat = "#,##0.00"

With Range("H1:H" & LastRow)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Range("R2:r" & LastRow)
.NumberFormat = "0.00"
.FormulaR1C1 = "=(RC[-1]/RC[-14])*100"
End With
'* my setting for range may need to be adjusted?
Range("D" & LastRow + 1 & ",Q" & LastRow + 1).FormulaR1C1 = "=SUM(R[-" & LastRow - 1 & "]C:R[-1]C)"
Range("S2:s" & LastRow).FormulaR1C1 = "=SUM(RC[-2],RC[-15])"
Cells.columns.AutoFit
Range("A1").Select
'I've added a password to the following code - on off chance it is wanted.
ActiveWorkbook.Protect Structu=True, Windows:=False, Password:="secret"
'* may be best if the screen updating is turned on at the end of the _
"looping macro" rather than here.
Application.ScreenUpdating = True

End Sub
--------------------


Test this on a copy of a file first before unleashing it & good luck
with the 400 files :-)

hth
Rob Brockett
NZ
Always learning & the best way to learn is to experience...


--
broro183
------------------------------------------------------------------------
broro183's Profile: http://www.excelforum.com/member.php...o&userid=30068
View this thread: http://www.excelforum.com/showthread...hreadid=529709