Appliquer une macro sur plusieurs fichiers
Résolu/Fermé
B95190
Messages postés
119
Date d'inscription
mardi 16 février 2010
Statut
Membre
Dernière intervention
14 juillet 2011
-
2 oct. 2010 à 12:11
B95190 Messages postés 119 Date d'inscription mardi 16 février 2010 Statut Membre Dernière intervention 14 juillet 2011 - 3 oct. 2010 à 15:49
B95190 Messages postés 119 Date d'inscription mardi 16 février 2010 Statut Membre Dernière intervention 14 juillet 2011 - 3 oct. 2010 à 15:49
A voir également:
- Appliquer une macro sur plusieurs fichiers
- Renommer plusieurs fichiers - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro word - Guide
- Wetransfer gratuit fichiers lourd - Guide
- Désinstaller une application sur pc - Guide
8 réponses
B95190
Messages postés
119
Date d'inscription
mardi 16 février 2010
Statut
Membre
Dernière intervention
14 juillet 2011
25
2 oct. 2010 à 12:33
2 oct. 2010 à 12:33
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.
cousinhub29
Messages postés
953
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
10 novembre 2024
344
2 oct. 2010 à 15:50
2 oct. 2010 à 15:50
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
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
cousinhub29
Messages postés
953
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
10 novembre 2024
344
Modifié par cousinhub29 le 3/10/2010 à 03:24
Modifié par cousinhub29 le 3/10/2010 à 03:24
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 :
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) :
Bonne nuit
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
cousinhub29
Messages postés
953
Date d'inscription
mardi 10 août 2010
Statut
Membre
Dernière intervention
10 novembre 2024
344
3 oct. 2010 à 12:44
3 oct. 2010 à 12:44
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 :
Par :
Ainsi les formules en colonne G iront jusqu'à la dernière cellule de la colonne "O" de la feuille 1
Bon dimanche
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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
B95190
Messages postés
119
Date d'inscription
mardi 16 février 2010
Statut
Membre
Dernière intervention
14 juillet 2011
25
2 oct. 2010 à 13:44
2 oct. 2010 à 13:44
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
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
B95190
Messages postés
119
Date d'inscription
mardi 16 février 2010
Statut
Membre
Dernière intervention
14 juillet 2011
25
Modifié par B95190 le 2/10/2010 à 23:16
Modifié par B95190 le 2/10/2010 à 23:16
Euh, ok. Mais comment faire cela en les ouvrants?.
B95190
Messages postés
119
Date d'inscription
mardi 16 février 2010
Statut
Membre
Dernière intervention
14 juillet 2011
25
3 oct. 2010 à 15:49
3 oct. 2010 à 15:49
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