Discussion :

[2biger]

Bonjour à toutes et à tous,

Je travaille actuellement sur un VBA dont le but est simple de synthétiser plusieurs fichiers Excel.
Sur chaque fichier excel, j'ai un tableau avec en haut à gauche une case "Exercices" et en bas à droite une case "Fin tableau". On peut ainsi définir la taille du tableau. La longueur des tableaux diffère mais pas leur largeur qui est donc la même.
Je souhaiterais merger tout ces tableaux sur un fichier Excel de synthèse.

Je vous mets un petit jpg pour vous expliquer en PJ.

Voici le code dont je m'inspire, mais je pense pas que ca soit la meilleure méthode (pour l'exemple je vais chercher sur un seul fichier pour le moment, mais le problème, c'est que je n'arrive pas à relire avec les coorodnnées enregistrées) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub ImporterDonnees()
Dim Chemin As String, Fichier As String, CaseInitialeApplication As String, CaseFinaleApplication As String, CaseInitialeExercice As String, CaseFinaleExercice As String, CaseInitialeAtelier As String, CaseFinaleAtelier As String
 
'A ADAPTER : ici adapter le chemin d'accès au répertoire contenant le fichier source des données
Chemin = "J:\Missions\Nouvelle Méthode\"
'A ADAPTER : nom du fichier source
Fichier = "Cholet.xlsx"
 
Workbooks.Open (Chemin & Fichier)
Visible = False
Workbooks(Fichier).Activate
Sheets("Cholet").Activate
 
CaseInitialeExercice = Cells.Find("Exercices", , xlValues).Address
CasesFinaleExercice = Cells.Find("Fin tableau", , xlValues).Address
 
Workbooks(Fichier).Close
 
'A ADAPTER : plage des données à importer
    'ICI : Feuil1'!$A$1:$F$10
ThisWorkbook.Names.Add "plage", _
            RefersTo:="='" & Chemin & "[" & Fichier & "]Cholet'!CaseInitialeExercice:CasesFinaleExercice"
 
 
 
    'A ADAPTER : nom de la feuille
        'Ici Feuil2 doit être remplacé par le nom d'une feuille vierge de ce classeur (classeur qui va importer les données)
    With Sheets("Tableau Global")
        'A ADAPTER : plage des données à importer
            'ICI : [A1:F10]
        .[CaseInitialeExercice:CasesFinaleExercice] = "=plage"
        'A ADAPTER : plage des données à importer
            'ICI : [A1:F10]
        .[CaseInitialeExercice:CasesFinaleExercice].Copy
        'A ADAPTER : Nom de la feuille devant accueillir les données + 1ère cellule ou copier ces données
        Sheets("Tableau Global").Range("A1").PasteSpecial xlPasteValues
        'A ADAPTER : plage des données à importer
            'ICI : [A1:F10]
        .[CaseInitialeExercice:CasesFinaleExercice].Clear
    End With
End Sub

Merci d'avance de vos propositions !

Rémi

[Nako_lito]

tes cellules Exercices / fin tableau ont elles une utilité autre que pour baliser tes tableaux ?

Tu peux utiliser la méthode .usedrange sur une worksheet pour obtenir la plage des cellules utilisées, tu fais un copy dessus et un paste à la suite du fichier qui regroupe les données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
    With ThisWorkbook
        .Sheets("global").Cells.Clear 'j'efface les données sur la feuille de destination
 
        .Sheets("Feuil1").UsedRange.Copy 'je copie depuis la feuille 1
        .Sheets("global").Range("A" & .Sheets("global").UsedRange.SpecialCells(xlLastCell).Row).PasteSpecial xlPasteValues 'je colle
        .Sheets("Feuil1").UsedRange.Copy 'je copie depuis la feuille 2
        .Sheets("global").Range("A" & .Sheets("global").UsedRange.SpecialCells(xlLastCell).Row + 1).PasteSpecial xlPasteValues 'je colle à la suite
        .Sheets("Feuil1").UsedRange.Copy 'je copie depuis la feuille 3
        .Sheets("global").Range("A" & .Sheets("global").UsedRange.SpecialCells(xlLastCell).Row + 1).PasteSpecial xlPasteValues 'je colle à la suite
    End With

Ce code fait abstraction des balises Exercices / fin tableau, qui a mon sens n'ont pas lieu d'être avec l'utilisation de usedrange. Si elle doivent être conservées, tu peux adapter pour éliminer la première ligne de usedrange.
Il peut être optimisé, avec une boucle par exemple si il y a bcp de fichier a traiter.

[2biger]

Merci Nako_lito de votre réponse !

Etant donné que je n'ai pas d'expérience en VBA, je ne connais pas toute les méthodes.
Je pense que votre méthode correspond parfaitement à ce que je cherche.
Un élément reste cependant flou. En effet, les différents tableaux se trouvent dans différents fichier Excel, et le tableaux récapitulatif est également dans un autre fichier Excel. Il ne s'agit donc pas simplement d'ouvrir les onglets (je ne sais pas si je suis clair dans mes explications). Soit :



De plus, dans chaque fichier Excel, il n'y a pas que ce tableau. Il y a d'autres éléments, c'est donc pour cela que j'ai les balises "Exercices" et "Fin tableau". Cela permet de délimiter la sélection du tout. Pour être plus clair :



Comme je vous l'ai dit, je ne sais pas si je suis clair. C'est donc pour cela que j’essaie d'illustrer mes explications. Si vous avez du temps, je veux bien votre aide
Merci d'avance !

Rémi

[Marc-L]

Bonjour Rémi,

joindre deux classeurs sources (Tableau x) enregistrés en .xlsx (sans macro) …

Indiquer aussi pour la synthèse s'il faut conserver l'existant ou pas de la feuille de destination,
voire même joindre le classeur de synthèse en cas de présentation particulière …

Normalement si chaque tableau est un bloc délimité par des lignes vides, seule la balise "Exercices" est nécessaire
en utilisant la propriété CurrentRegion.

L'idéal aurait été de nommer l'intégralité de la plage à récupérer …

[2biger]

Merci Marc-L !

J'aime bien Currentregion, et je pense pouvoir m'en servir pour délimiter mon espace.

Pour ce qui est de joindre les tableaux, en fait sur le fichier de la macro, qui est le fichier synthèse, j'ai un onglet qui indique les chemins des différents fichiers à merger.
Ainsi, dans ma macro, je vais les prendre un par un.

L'objectif et de pouvoir automatiser cela.

Car je vais devoir faire cette étape assez fréquemment, et si je pouvais éviter de les merger à la main, je préférerai

Mais si cela est impossible, je me débrouillerai autrement !

Encore merci,

Rémi

[Nako_lito]

Je suis pas certain que le current region soit la bonne option, comme il l'a montré dans le post #3, il a des données rattaché à son tableau. Le current region va les intégrer ce qui n'avancera à rien.

J'ai ça a te proposer:
C'est pas super clean, et y'a matière a le reprendre et l'adapter au besoin mais chez moi ca fonctionne avec les pré requis que tu as indiqué :

A savoir, plusieur fichiers dans un même répertoire.

J'ai créé un fichier "global" qui va recevoir le contenu des autre fichiers.
Pour simplifier j'ai utilisé une seule feuille dans chaque classeur (mais c'est paramétrable dans le code en changeant les set)

Mets ça dans un module d'un fichier tierce qui ne fera qu'exécuter la macro (dans mon répertoire, j'ai 3 fichier exemples, 1 fichier qui recoit les données, mon fichier macro, je joins le tout au fil de discussion)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Public Sub main()
    Dim lColFilesToManage   As Collection
    Dim workingWB           As Workbook
    Dim workingWS           As Worksheet
    Dim workingRG           As Range
    Dim globalWB            As Workbook
    Dim globalWS            As Worksheet
 
    Application.ScreenUpdating = False
 
    Set lColFilesToManage = getAllFiles(ThisWorkbook.Path) 'on liste dans une collection tous les paths des fichiers qu'on veut merger
    Set globalWB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\global_.xlsx") 'ouvre le fichier "global"
 
    For i = 1 To lColFilesToManage.Count
        Set workingWB = Workbooks.Open(lColFilesToManage(i))  'ouvre le fichier source numéro i
        Set workingWS = workingWB.Sheets(1)
        Set workingRG = manageRange(workingWS.Range(getCell(workingWS, True), getCell(workingWS, False)))
        If Not workingRG Is Nothing Then
            Set globalWS = globalWB.Sheets(1)
            workingRG.Copy 'copie les datas du fichier en cours de traitement
            globalWS.Range("A" & getRow(globalWS)).PasteSpecial xlPasteValues 'colle les datas a la suite de l'existant du fichier global
        End If
        workingWB.Close False 'ferme le classeur 1, 2, 3
    Next i
    Application.DisplayAlerts = False
    globalWB.Close True
    Application.DisplayAlerts = True
 
    Set workingWB = Nothing
    Set workingWS = Nothing
    Set workingRG = Nothing
    Set wbGlobal = Nothing
    Set lColFilesToManage = Nothing
 
    Application.ScreenUpdating = True
End Sub
 
Private Function manageRange(ByRef pRg As Range) As Range
    Dim range_ As Range
    Set range_ = pRg
    If LCase(range_.Cells(1).Value) = "exercices" Then
        range_.Rows(1).Delete shift:=xlUp
        range_.Cells(range_.Cells.Count).EntireRow.Delete shift:=xlUp
    End If
    Set manageRange = range_
End Function
 
Private Function getRow(ByVal pws As Worksheet) As Integer
    If pws.UsedRange.Rows.Count = 1 Then
        getRow = 1
    Else
        getRow = pws.UsedRange.Rows.Count + 1
    End If
End Function
 
Private Function getCell(ByVal pws As Worksheet, ByVal FirstLast As Boolean) As Range
    Dim range_ As Range
    Select Case FirstLast
    Case True
        Set range_ = pws.Cells.Find("exercices", LookIn:=xlValues)
    Case False
        Set range_ = pws.Cells.Find("fin tableau", LookIn:=xlValues)
    End Select
 
    If Not range_ Is Nothing Then
        Set getLastCell = range_
    Else
        Set getLastCell = Nothing
    End If
End Function
 
Private Function getAllFiles(ByVal pStrPath As String) As Collection
    Dim colFiles    As Collection
    Dim strFiles    As String
    Dim objFSO      As Object
    Dim objFoler    As Object
    Dim objFile     As Object
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Get the folder object
    Set objFolder = objFSO.GetFolder(pStrPath)
    Set colFiles = New Collection
    For Each objFile In objFolder.Files
        If InStr(LCase$(objFile.Name), "global") Then GoTo Next_
        If InStr(LCase$(objFile.Name), "macro") Then GoTo Next_
        colFiles.Add objFile.Name, objFile.Name
Next_:
    Next
 
    Set getAllFiles = colFiles
    Set colFiles = Nothing
End Function

Macro.xlsm
exemple 2.xlsx
exemple 3.xlsx
global_.xlsx
exemple 1.xlsx

[2biger]

Merci encore Nako_lito,

Je suis entrain d'essayé d'adapter ton code, mais je ne comprends pas tout ..

J'ai une erreur au niveau de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set workingWB = Workbooks.Open(lColFilesToManage(i))  'ouvre le fichier source numéro i

Je l'ai mis comme ça, mais je dois peut-être le modifier ?

Voilà l'erreur :


Est-ce parce que le fichier est ouvert en même temps ?

Excusez mon noobisme

Encore merci,

Rémi

[Nako_lito]

La macro se base sur le répertoire d'ou elle est lancée.

Par exemple si le fichier macro est sur le bureau et que les fichiers sont dans mes documents, ils les trouvera pas.

Il te plante a cette ligne, je pense, car il y a des fichiers non excel dans le répertoire ou est la macro.

Comme je l'ai dit, c'est une version assez basique sans aucune gestion d'erreur.

Pour que ca fonctionne, il faut mettre les 5 fichiers que j'ai joins dans le meme répertoire et sans rien avec autour, sinon, il faut adapter le code. Mais les grandes lignes sont là :

- lister les fichiers a importer
- ouvrir le classeur qui va recevoir toutes les données
- ouvrir les fichiers a extraire un par un
- fermer les fichiers a extraire quand on a pris les données
- fermer le classeur qui recois les données

Je ne connais pas ton niveau en Excel ou en prog en général donc je peux pas vraiment savoir la marge d'erreur qu'il faut laisser dans le code.

[2biger]

Merci de ton retour.

Tous les fichiers sont dans le même dossier et il n'y a rien d'autre.
Je n'avais pas ouvert les fichiers, c'est donc peut-être une des erreurs, je pensais qu'ils s'ouvriraient tout seul

Sinon l'erreur pourrait venir de l'extension des fichiers ? (Tous .xlsx sauf macro .xlsm).

Pour mon niveau, je sais un peu programmer, donc je peux comprendre du code, mais je connais pas du le VBA (syntaxe).

Merci du temps que tu passes sur mon cas

Rémi

[2biger]

J'ai trouvé ce qui n'allait pas
J'ai ajouté cela : ThisWorkbook.Path & "\" & et maintenant cette étape passe.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set workingWB = Workbooks.Open(ThisWorkbook.Path & "\" & lColFilesToManage(i)) 'ouvre le fichier source numéro i

Sauf que quand ca passe ici, ça casse après

Maintenant cette étape ne passe pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set workingRG = manageRange(workingWS.Range(getCell(workingWS, True), getCell(workingWS, False)))

Voici la fenêtre d'erreur :



Si quelqu'un a des idées

Merci à tous,

Rémi

[Nako_lito]

Alors, premiere chose, cette ligne indique le fichier "global" doit être d'extension .xlsx, si c'est du 2003, remplacer par .xls.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set globalWB = Workbooks.Open(Filename:=ThisWorkbook.Path & "\global_.xlsx") 'ouvre le fichier "global"

Ensuite, pour les fichiers qui reviennent dans la liste lColFilesToManage, mets un point d'arret juste après la ligne 11 et regarde ce que contient ta liste. Si il y a autre chose que tes 3 fichiers, ton erreur peut venir de là.

[2biger]

Pour le XLSX, ce n'est pas un problème je suis sur Excel 2010 et mes fichiers sont bien en XLSX.

Pour ce qui est de ce que contient lColFilesToManage, il contient bien mes 5 fichiers :
- 1.xlsx
- 2.xlsx
- 3.xlsx
- 4.xlsx
- 5.xlsx

L'erreur vient d'ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Set workingRG = manageRange(workingWS.Range(getCell(workingWS, True), getCell(workingWS, False)))

Je vais devoir y aller, je bosse pour une association ce soir

Je reprends ca demain matin.

Encore merci pour tout,

Rémi

[2biger]

Je viens de voir que workingWS était vide, surement a cause de l'onglet définit précédemment, je verrais ca demain

Bonne soirée,

Rémi

[Marc-L]

joindre deux classeurs sources (Tableau x) enregistrés en .xlsx (sans macro) …

Indiquer aussi pour la synthèse s'il faut conserver l'existant ou pas de la feuille de destination,
voire même joindre le classeur de synthèse en cas de présentation particulière …

Quand tu veux Rémi ‼ Si tu veux éviter l'usine à gaz; normalement aucun besoin de déclarer de variable objet …

[2biger]

Merci Marc-L.

Je vais essayé de joindre les classeurs et ensuite d'utiliser le code initial de Nako-Lito.

Je vous tiens au courant !

Rémi

[2biger]

Bonjour,

Désolé du temps de réponse, donc je vais clore le sujet.
J'ai trouvé la solution la plus simple qui est .... LE NOMMAGE DE PLAGES DE CELLULES !!!

Et oui, je définis des noms de cellules sur les différents fichiers à traiter.
Et ensuite je copie les sélections sur un fichier récapitulatif ou j'ai mes petits TCD

Merci à tous pour vos différentes actions !

Rémi

[Marc-L]

Ce que j'ai indiqué dès le post #4 ! …

[2biger]

En effet Marc-L !

J'ai pu reprendre un bout de code d'un collègue et développer autour de ça !
C'était mon premier sujet sur le forum et j'ai été réellement surpris de la vitesse de réponse !

Je vous remercie encore

Rémi