In message <
[email protected]
s.com> of Tue, 7 Dec 2010 23:17:11 in microsoft.public.excel.programming
It might be nice if you said which version of Excel you use. The
solution might be different for different versions.
I assume running a macro in 150 files, one at a time is acceptable.
I assume a folder object will give you the names of files which include
those you want to run. help folder in Visual Basic Window will help.
I would construct pseudo code like:
set folder = root folder
call tree folder
sub tree(folder)
for each file in folder
if relevant file then Call Macro file
next file
for each subfolder in folder
if relevant subfolder then call tree subfolder
next subfolder
end sub
I run a given macro on up to about 10 files in one folder by selecting
the names in Windows Vista and opening the files in Excel 2003.
I then run code like this:
Dim wq As Workbook
call initialisation
For Each wq In Workbooks
SingleFileAction
Next wq
I am sorry not to be more helpful.
If you can expand your requirement, you may get more specific help.
Please say how you get on.
Dear Walter Briscoe
My excel version is 2003.
I want to run below recorded macro in several worksheet in a folder at
a time . I will be very thank full to you, if you add vba language
for running macro in all worksheet around below vba code.
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 26/07/2010
'
' Keyboard Shortcut: Ctrl+y
'
Sheets("Sheet1").Copy After:=Sheets(1)
Sheets("Sheet1 (2)").Name = "Policy Annexure"
Columns("A
").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("C
").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("I:AH").Select
Selection.Delete Shift:=xlToLeft
Range("H1").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Cells.Select
With Selection.Font
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
With Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
With Selection.Font
.Name = "Arial"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Range("A1").Select
Columns("A:A").Select
Range("A2").Activate
Selection.RowHeight = 26.25
Range("H2").Select
Selection.End(xlDown).Select
Range("G71").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Rows("1:1").Select
Selection.Replace What:="_", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.End(xlUp).Select
Range("C2").Select
Range(Selection, Selection.End(xlDown)).Select
Columns("C:G").Select
Range("C2").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.End(xlUp).Select
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "#,##0"
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2").Select
Selection.End(xlDown).Select
Range("A71").Select
Selection.ColumnWidth = 8.71
Range("B71").Select
Selection.Columns.AutoFit
Range("B72").Select
Selection.Columns.AutoFit
Selection.ColumnWidth = 32.71
Range("C72").Select
Selection.ColumnWidth = 20
Range("D72").Select
Selection.ColumnWidth = 11.57
Range("E72").Select
Selection.ColumnWidth = 10.57
Range("F72").Select
Selection.ColumnWidth = 22.71
Range("G72").Select
Selection.ColumnWidth = 10.86
Range("H72").Select
Selection.ColumnWidth = 11.4
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
Rows("1:1").RowHeight = 32.25
ActiveCell.FormulaR1C1 = "Under Writter Off Cd"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "GROUP NAME"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("C1").Select
ActiveCell.FormulaR1C1 = "POLICY NO"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "COMMENCEMENT DT"
With ActiveCell.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "VALID UPTO"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "ENDORSEMENT NO"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "ENDORSEMENT DT"
With ActiveCell.Characters(Start:=1, Length:=14).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "PREMIUM"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("G1").Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D2").Select
'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&""Arial,Bold""Page &P Of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.PrintErrors = xlPrintErrorsDisplayed
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&""Arial,Bold""Page &P Of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.PrintErrors = xlPrintErrorsDisplayed
End With
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&""Arial,Bold""Page &P Of &N"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.PrintErrors = xlPrintErrorsDisplayed
End With
Dim ws As Worksheet
Dim NextCell As Range
Dim LastRow As Long
'why select all the sheets first?
'Worksheets.Select
'For Each ws In ActiveWindow.SelectedSheets
' begin repeat for all worksheets
For Each ws In ActiveWorkbook.Worksheets
With ws
If .UsedRange.Address = "$A$1" Then
'skip it
Else
' Add formula to blank cell at bottom of column 8
LastRow = .Cells(.Rows.Count, "H").End(xlUp).Row + 1
.Cells(LastRow, 8).Formula = "=COUNTA(H2:H" & LastRow
- 1 & ")"
' Move eight cells to right, bold and add text
With .Cells(LastRow, 7)
.Font.Bold = True
.FormulaR1C1 = "Total"
.Font.Size = 9
End With
With .Cells(LastRow, 8)
.Font.Bold = True
.Formula = "=SUBTOTAL(9,H2:H" & LastRow - 1 & ")"
.HorizontalAlignment = xlRight
.NumberFormat = "#,##0"
.Font.Size = 9
End With
With .Cells(LastRow, 7).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Cells(LastRow, 8).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Cells(LastRow, 7).Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With .Cells(LastRow, 8).Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End If
End With
Next ws
MsgBox ("DONE....!")
End Sub