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

[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