View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
PY & Associates PY & Associates is offline
external usenet poster
 
Posts: 145
Default 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