Apply a macro to multiple files

Thank you Dany =D. There is a small problem: I am a beginner and I don’t understand this code, so could you quickly explain this code to me, please, so I know where I should apply changes. Thank you again.

Hello,

The code for "Dany", if it works, nevertheless won’t work with Excel versions >= 2007... (FileSearch no longer exists in these versions...)

However, you can apply your formula to all files in a directory by opening them, but without it being visible on screen...

It’s an "alternative" solution, risk-free, and it works every time....

Work on a closed file is possible, but requires a certain level of knowledge, which, given the code you just posted, doesn’t seem to be within your reach, without wanting to offend you...

And then, an update, on a Saturday afternoon, after 1 hour and a half of waiting.... not great

Have a good weekend

Hello,

With this code, you open the files that are in the same directory as the workbook that contains the macro. You can of course change the directory....
For that you modify the value of:

LePath = D:\Users\TonNom\Documents\Excel

For example....

From what I understand, in each file, we put a formula in sheet 2, and extend it over 1000 rows...
Make sure the tabs are named correctly "Feuil1" and "Feuil2"...
Otherwise, in "Feuil2", in which column could you find the last filled row, in order not to increment the formula up to row 1000, but only up to the last filled row...

While waiting for your clarifications, here is the code (which works in 2007):

Sub Modifie_Classeurs() Dim Fich As String, LePath As String Application.ScreenUpdating = False LePath = ActiveWorkbook.Path 'Assuming the files are in the same directory as the workbook 'otherwise you put the path of your files Fich = Dir(LePath & "\*.xls") Do While Fich <> "" If Fich <> ActiveWorkbook.Name Then Workbooks.Open Filename:=Fich With Sheets("Feuil2") .Range("G1").FormulaR1C1 = "=Feuil1!RC[8]" .Range("G1").AutoFill Destination:=.Range("G1:G1000"), Type:=xlFillDefault .Columns("G:G").EntireColumn.AutoFit End With Workbooks(Fich).Close True End If Fich = Dir ' next workbook Loop End Sub 

Good night

As proposed, it is obviously preferable to extend the formulas in column G only up to the last filled cell.... We will therefore take Sheet1 as reference, and column "O" of this sheet... So you replace:

.Range("G1").AutoFill Destination:=.Range("G1:G1000"), Type:=xlFillDefault

With:

.Range("G1").AutoFill Destination:=.Range("G1:G" & Sheets("Sheet1").[O65000].End(xlUp).Row), Type:=xlFillDefault

Thus the formulas in column G will go up to the last cell of column "O" on Sheet1 Have a good Sunday

hello

see if this may suit you
Option Explicit
Public dossier
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = ""
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Sub Traiter_Dossier()
'Objectif : traiter les fichiers d'un répertoire
'
Dim fs, i, nomfich, FileNumber, specfichier, nbfichiers
Dim fso As New FileSystemObject
dossier = GetDirectory("choose the folder to process")
If dossier <> "" Then
Set fs = Application.FileSearch
With fs
.LookIn = dossier
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
nbfichiers = .FoundFiles.Count
MsgBox "This folder contains " & nbfichiers & " file(s) matching the criteria."
For i = 1 To nbfichiers
specfichier = .FoundFiles(i)

'*********************
'Put the processing to perform here
'*********************

Next i
Else
MsgBox "No file was found."
End If
End With
End If
End Sub

Here is the English translation of the provided macro code and accompanying text: The code of the macro I want to apply to all my files. I specify that my files are .xlsx and that I am using Excel 2007. Thank you for your help.

Sub new_company()
'
' new_company Macro
'

'
Range("AH24").Select
Sheets("Feuil2").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "=Feuil1!RC[8]"
Range("G1").Select
Selection.AutoFill Destination:=Range("G1:G1000"), Type:=xlFillDefault
Range("G1:G1000").Select
ActiveWindow.ScrollRow = 971
ActiveWindow.ScrollRow = 934
ActiveWindow.ScrollRow = 853
ActiveWindow.ScrollRow = 627
ActiveWindow.ScrollRow = 505
ActiveWindow.ScrollRow = 430
ActiveWindow.ScrollRow = 351
ActiveWindow.ScrollRow = 309
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 293
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 270
ActiveWindow.ScrollRow = 252
ActiveWindow.ScrollRow = 218
ActiveWindow.ScrollRow = 193
ActiveWindow.ScrollRow = 171
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 133
ActiveWindow.ScrollRow = 127
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 123
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 112
ActiveWindow.ScrollRow = 108
ActiveWindow.ScrollRow = 104
ActiveWindow.ScrollRow = 100
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Range("G1").Select
Columns("G:G").EntireColumn.AutoFit
End Sub

Um, okay. But how to do that with the openers?

Thank you, that's great; What I actually wanted (I expressed myself poorly) was to adjust the WIDTH of the column, that is, if for example the cell contains the word "crocodile", I would like the column to take the width of the longest word in the column. Thank you very much. Have a nice Sunday as well =D