0/5 (2 avis)
Snippet vu 14 835 fois - Téléchargée 20 fois
Sub LaunchCompilation() ' Ce code doit servir à regrouper les données des feuilles de plusieurs classeurs Excel enregistrés dans le même dossier que ce classeur Application.DisplayAlerts = False ' pour éviter les message demandant confirmation lors d'une fermeture (notamment le fait d'avoir des données dans le presse papier chemin = ThisWorkbook.Path 'chemin du dossier qui contient les autres fichiers et où est enregistré ce fichier qui servira de compilateur Set fso = New FileSystemObject 'l'utilisation des FSO nécessite l'activation de la référence Microsoft Scripting Runtime Set dossier = fso.GetFolder(chemin) ' Dim r As Integer ' r sera le n° de la ligne de la feuille compilateur r = 1 Dim nbfichiers ' nbfichier sera le nombre de fichiers traités nbfichier = 0 Dim listedesfichierstraités As String For Each fichier In dossier.Files ' boucle sur les fichiers If fso.GetExtensionName(fichier.Path) = "xls" And fichier.Name <> ThisWorkbook.Name Then 'sélection des fichiers à traiter : classeurs excel et pas le compilateur nbfichiers = nbfichiers + 1 listedesfichierstraités = listedesfichierstraités & fichier.ShortName & Chr(10) Workbooks.Open fichier 'ouverture d'un fichier For i = 1 To ActiveWorkbook.Sheets.Count ' boucle sur les feuilles de ce fichier Sheets(i).Select 'sélection de la feuille Select Case i Case 1 lastrow1 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C Range(Cells(1, 1), Cells(lastrow1, 4)).Copy 'copie des cellules de la plage A1:D dernière ligne ThisWorkbook.Activate 'on se place sur le fichier de compilation Sheets(1).Cells(r, 1).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne A ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial Case 2 lastrow2 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C Range(Cells(1, 1), Cells(lastrow2, 6)).Copy 'copie des cellules de la plage A1:F dernière ligne ThisWorkbook.Activate 'on se place sur le fichier de compilation Sheets(1).Cells(r, 5).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne E ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial Case 3 lastrow3 = Cells(65536, 3).End(xlUp).Row 'détermination de la dernière ligne à copier selon la présence de données dans la colonne C Range(Cells(1, 1), Cells(lastrow3, 3)).Copy 'copie des cellules de la plage A1:C dernière ligne ThisWorkbook.Activate 'on se place sur le fichier de compilation Sheets(1).Cells(r, 11).Select 'on sélectionne la 1ère feuille, et la première cellule encore vide de la colonne K ActiveSheet.Paste ' collage simple, si les données contiennent des formules peut-être mieux vaut un pastespecial End Select Cells(r, 1).EntireRow.Interior.ColorIndex = 1 Workbooks(fichier.Name).Activate Next i If lastrow1 > lastrow2 And mastrow1 > lastrow3 Then lastrow = lastrow1 Else If lastrow2 > lastrow1 And lastrow2 > lastrow3 Then lastrow = lastrow2 Else lastrow = lastrow3 End If End If r = r + lastrow 'on ajoute à r la dernière ligne pour toujours se placer sur la 1ère cellule vide de la colonne A Workbooks(fichier.Name).Close (False) 'on ferme le fichier ouvert précédemment End If Next fichier Application.DisplayAlerts = True 'on rétablie le paramétrage standard Cells(1, 1).Select MsgBox ("Le traitement est terminé." & Chr(10) & nbfichiers & " fichiers ont été traités, en voici la liste :" & Chr(10) & listedesfichierstraités) End Sub
29 mars 2010 à 10:37
dans le même ordre d'idée tu devrais forcer la déclaration des variables (option explicit)ta variable lastrow1 est devenue mastrow1
Je ne comprends pas non plus l'utilité des faire 3 variables lastrow alors qu'elle calcul la même chose
bonne prog
deuxmains
23 mars 2010 à 21:40
-------------------------------------
Il est délicat de travailler sur les objets courants.
Il suffit que l'utilisateur est la gâchette facile sur la souris, et le classeur que l'on croyait actif n'est plus le même et tout part en vrille.
Ceci est particulièrement vrai sur les traitement un peu long.
Plutôt que d'utiliser ActiveSheet ou cells directement,
Iil vaudrait mieux travailler sur des instances d'objet:
exemple:
dim wb as workbook
set wb = Workbooks.Open fichier 'ouverture d'un fichier
'et ensuite utiliser wb pour travailler sur ce classeur
'par exemple pour mettre une valeur dans une feuille:
wb.worksheets("nomDeLaFeuille").cells(1,1)= laValeur
ou
dim ws as worksheet
set ws=wb.worksheets("nomDeLaFeuille")
ws.cells(1,1)= laValeur
Attention si depuis Excel 2000 il y a bien 65536 lignes dans un classeurs, dans les versions antérieure il n'y en a que la moitié (Beaucoup d'applis Excel tournent encore sur des versions 97).
Toute les feuilles du classeur source sont traitées, quid des feuilles masquées par exemple ?
de plus c'est la collection Sheets qui est parcourue, mais dans sheets il peut y avoir d'autre type de feuilles: graphique, ancienne macro excel 4 (he oui y en a encore!!!) ...
Il est préférable de parcourir la collection worksheets, ou alors il faut tester le type de la feuille.
J'espère que ces remarques t'aideront à fiabiliser ce code.
JJDAI
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.