Apply the same macro code to all excel files in a folder

Hi all,

I need a big help..

I created a Macro Code and I need apply this code to all excel files in a folder, because I have approximately one thousand files.. Yes, true..

Open one to one, its impossible..


Please, Help me in this problem.
since now, thank you very much

Best regards,

Hello Alano,

If you would post the macro code, it would be easier to give you an answer.

Thanks,
Leith Ross

In theory yes

As Leith said post your macro for a definate answer and it would be best if your macro included code for opening (especially required if not xls files) and closing the file and any file saving required.

The Macro Code is:



Sub Formatando_RED_Lojas()

' Macro gravada em 2/2/2007 por Remil
'
Dim Arq As String

'
Arq = ActiveWorkbook.Name
ChDir "H:\Pessoal_H\RED - Automatização\Modelos"
Workbooks.Open Filename:= _
"H:\Pessoal_H\RED - Automatização\Modelos\Modelo_Coord.xls"
Windows(Arq).Activate
Sheets("AS").Select
Range("A4").Select
Selection.Copy
Windows("Modelo_Coord.xls").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arq).Activate
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Modelo_Coord.xls").Activate
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arq).Activate
Sheets("MF").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Modelo_Coord.xls").Activate
Sheets("MF").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arq).Activate
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Modelo_Coord.xls").Activate
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arq).Activate
Windows("Modelo_Coord.xls").Activate

' Alterando o PV
Sheets("PV").Select
Windows(Arq).Activate
Sheets("PV").Select
Range("A4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Modelo_Coord.xls").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arq).Activate
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Modelo_Coord.xls").Activate
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(Arq).Activate
Sheets(Array("AS", "MF", "PV")).Select
Sheets("AS").Activate
Columns("M:X").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Sheets("AS").Select
Range("A1").Select
Windows("Modelo_Coord.xls").Activate
Sheets("AS").Select
Rows("1:9").Select
Application.CutCopyMode = False
Selection.Copy
Windows(Arq).Activate
Sheets("AS").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Windows("Modelo_Coord.xls").Activate
Range("BB10:BK10").Select
Application.CutCopyMode = False
Selection.Copy
Windows(Arq).Activate
Range("BB10").Select
ActiveSheet.Paste

Application.CutCopyMode = False
Selection.Copy
Range("BB10:BK528").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("5:65000").Select
With Selection.Font
.Name = "Arial"
.Size = 8
End With
Columns("A:A").Select
Selection.ColumnWidth = 16.43
Windows("Modelo_Coord.xls").Activate
Sheets("AS").Select
Cells.Select
Selection.Copy
Windows(Arq).Activate
Cells.Select
'Range("A3").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'ActiveWindow.SmallScroll Down:=-6
'Application.CutCopyMode = False
'Range("A10").Select
ActiveWindow.DisplayGridlines = False

Columns("L:BA").Select
Selection.ColumnWidth = 3.86
Columns("BB:BJ").Select
Selection.ColumnWidth = 7
Columns("BK:BK").Select
Selection.ColumnWidth = 25
Columns("B:K").EntireColumn.AutoFit
Range("A1").Select
Sheets("MF").Select
Windows("Modelo_Coord.xls").Activate
Sheets("MF").Select
Rows("1:9").Select
Selection.Copy
Windows(Arq).Activate
Rows("1:1").Select
Sheets("MF").Select
Selection.Insert Shift:=xlDown
Range("AL10").Select
Windows("Modelo_Coord.xls").Activate
Range("AL10:AX10").Select
Application.CutCopyMode = False
Selection.Copy
Windows(Arq).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("AL10:AX528").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Windows("Modelo_Coord.xls").Activate
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Windows(Arq).Activate
Cells.Select
Range("AI3").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-15
Application.CutCopyMode = False
Range("A1").Select
ActiveWindow.DisplayGridlines = False
Columns("L:AK").Select
Selection.ColumnWidth = 3.86
Columns("AL:AW").Select
Selection.ColumnWidth = 7
Columns("AX:AX").Select
Selection.ColumnWidth = 25
Columns("B:K").EntireColumn.AutoFit
Range("A1").Select
Sheets("PV").Select
Range("A1").Select
Windows("Modelo_Coord.xls").Activate
Sheets("PV").Select
Rows("1:9").Select
Selection.Copy
Windows(Arq).Activate
Rows("1:1").Select
Selection.Insert Shift:=xlDown
ActiveWindow.DisplayGridlines = False
Windows("Modelo_Coord.xls").Activate
Range("AK10:AV10").Select
Application.CutCopyMode = False
Selection.Copy
Windows(Arq).Activate
Range("AK10").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("AK10:AW10").Select
Selection.Copy
Range("AK10:AW528").Select
ActiveSheet.Paste
Application.CutCopyMode = False

Columns("L:AJ").Select
Selection.ColumnWidth = 3.86
Columns("AK:AV").Select
Selection.ColumnWidth = 7
Columns("AW:AW").Select
Selection.ColumnWidth = 25
Columns("B:K").EntireColumn.AutoFit
Range("A1").Select

'
Windows("Modelo_Coord.xls").Activate
Cells.Select
Selection.Copy
Windows(Arq).Activate
Cells.Select
Range("A3").Activate
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveWindow.SmallScroll Down:=-15
Application.CutCopyMode = False
Windows("Modelo_Coord.xls").Activate

ActiveWindow.Close SaveChanges:=False
Windows(Arq).Activate
Range("A1").Select
Sheets("AS").Select
ChDir "H:\Pesquisas\RED\RED 2007\01 Janeiro\Relatório por Coordenador"
ActiveWorkbook.SaveAs Filename:= _
"H:\Pesquisas\RED\RED 2007\Relatório de Lojas - 2007\" & Arq, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub


Need more information?

Thank you very much,
Alano Xavier

The changes/Additions I have made are in Red

The save as part of your code may need more work to avoid overwritting the same file.

The Stop command can be removed - it is there to allow for stepping through the macro

Please Login or Register  to view this content.

I will do a test and reply the result.
Thank you very much for you attention with this case!