Appliquer une macro sur plusieurs fichiers

Merci dany =D. Il y a une petit problème, c'est que je suis débutant et que je ne comprends donc pas ce code; Pourrait tu m'expliquer rapidement ce code s'il te plait,Pour que je sache où est-ce que je dois appliquer des modifications.Je te remercie encore.

Bonjour,

Le code de "Dany", s'il est efficace, ne fonctionnera cependant pas avec les versions d'Excel >= 2007...(FileSearch n'existe plus dans ces versions...)

Cependant, tu peux affecter ta formule dans tous les fichiers d'un répertoire, en les ouvrant, mais sans que cela se voit à l'écran...

C'est une solution "alternative", sans risque, et qui fonctionne à tous les coups....

Un travail sur fichier fermé est possible, mais demande un certain niveau de connaissances, qui au vu du code que tu viens de déposer, ne semble pas à ta portée, sans vouloir t'offenser...

Et pis, un UP, un samedi après-midi, après 1 heure et demie d'attente....pas glop

Bon W-E

Bonjour,

Avec ce code, tu ouvres les fichiers qui sont dans le même répertoire que le classeur qui contient la macro. Tu peux bien évidemment changer le répertoire....
Pour cela tu modifies la valeur de :

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

Par exemple....

De ce que j'ai compris, dans chaque fichier, on met une formule dans la feuille 2, et on l'étend sur 1000 lignes...
Assures-toi que les onglets se nomment bien "Feuil1" et "Feuil2"...
Sinon, dans la "Feuil2", dans quelle colonne pourrait-on trouver la dernière ligne remplie, afin de ne pas incrémenter la formule jusqu'à la ligne 1000, mais uniquement jusqu'à la dernière ligne remplie...

En attendant tes précisions, voici le code (qui fonctionne sous 2007) :

Sub Modifie_Classeurs() 
Dim Fich As String, LePath As String 
Application.ScreenUpdating = False 
LePath = ActiveWorkbook.Path 
    'En supposant que les fichiers sont dans le même répertoire que le classeur 
    'sinon tu mets le chemin de tes fichiers 
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     ' classeur suivant 
Loop 
End Sub 

Bonne nuit

Re-,

Comme proposé, il est évidemment préférable de n'étendre les formules de la colonne G que jusqu'à la dernière cellule remplie....

On va donc prendre la feuille 1 comme référence, et la colonne "O" de cette feuille...

Donc tu remplaces :

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

Par :

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

Ainsi les formules en colonne G iront jusqu'à la dernière cellule de la colonne "O" de la feuille 1

Bon dimanche

bonjour

regarde si cela peut te convenir
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("choisissez le dossier à traiter")
If dossier <> "" Then
Set fs = Application.FileSearch
With fs
.LookIn = dossier
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
nbfichiers = .FoundFiles.Count
MsgBox "Ce dossier contient " & nbfichiers & " fichier(s) répondant aux critères."
For i = 1 To nbfichiers
specfichier = .FoundFiles(i)

'*********************
'Mettre ici le traitement à réaliser
'*********************

Next i
Else
MsgBox "Aucun fichier n'a été trouvé."
End If
End With
End If
End Sub

Voici le code de la macro que je souhaite appliquer à tous mes fichiers. Je précise que mes fichiers sont des .xlsx et que je suis sous excel 2007.Je vous remercie pour votre aide.

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

Euh, ok. Mais comment faire cela en les ouvrants?.

Merci, c'est super; Ce que je voulais en fait (je me suis mal exprimé) s'était adapter la LARGEUR de la colonne c'est a dire que si par exemple la cellule contient le mot "crocodile", je voudrais que la colonne prenne la largeur du mot le plus long de la colonne. Je te remercie beaucoup. Bon dimanche aussi =D