Discussion :

[phoenix974]

Bonjour à tous,

Je cherche à consolider des exports (onglet"Data") (nombre variables comprenant 10 000 lignes environ chaque) qui sont situé sur un lecteur reseau dans un autre fichier RECAP sur l'onglet "DataConso".

J'essaie pas mal de chose mais je n'arrive pas à trouver le bon code et l'adapter à ma situation.

Quelqu'un pourrait il m'aider à avancer?

Merci d'avance

Voici les différents code que j'ai trouvé:

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Option Explicit
Sub test()
Dim MonRepertoire As String, fso As Object, f As Object, i As Integer
Set fso = CreateObject("Scripting.FileSystemObject")
MonRepertoire = "H:\AUTRE\SOPHIE\BASE GAD\EXTRACTION\"
For Each f In fso.GetFolder(MonRepertoire).Files
    If Right(f.Name, 4) = ".xls" Then Workbooks.Open MonRepertoire & f.Name
Next f
End Sub
 
 
Sub ouvrir()
Dim Fichier As String
Dim Chemin As String
Dim Fichier_Recap As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
'ChDir ActiveWorkbook.Path
 
Fichier_Recap = ActiveWorkbook.Name
 
    'Définit le répertoire contenant les fichiers
    Chemin = "H:\AUTRE\SOPHIE\BASE GAD\EXTRACTION\"
 
    'Boucle sur tous les fichiers xls du répertoire.
Fichier = Dir(Chemin & "*.xlsx")
Fichier = Dir("*.xls")
If Fichier = "" Then Exit Sub
Do Until Fichier = ""
    If Fichier <> Fichier_Recap Then
        Workbooks.Open Fichier
        Workbooks(Fichier).Sheets("base").Copy After:=Workbooks(Fichier_Recap).Sheets(1)
        Workbooks(Fichier).Close
    End If
    Fichier = Dir
Loop
End Sub
 
 
Sub ouvrir_avec_mdp()
Dim Fichier As String
Dim Fichier_Recap As String
Application.ScreenUpdating = False
ChDir ActiveWorkbook.Path
Fichier_Recap = ActiveWorkbook.Name
Fichier = Dir("*.xls")
If Fichier = "" Then Exit Sub
Do Until Fichier = ""
    If Fichier <> Fichier_Recap Then
        Workbooks.Open Fichier, Password:="cdg"
        Workbooks(Fichier).Sheets("base").Copy After:=Workbooks(Fichier_Recap).Sheets(1)
        Workbooks(Fichier).Close
    End If
    Fichier = Dir
Loop
End Sub
 
Sub Ouvrir_Fichiers()
' Permet d'ouvrir plusieurs fichiers dans un répertoire
' GC Excel - 2011-11-16
 
Dim wb As Workbook, wb2 As Workbook
Dim sPath As String, sFilename As String
Dim NbRows As Integer, rg As Range
 
Set wb = ThisWorkbook
 
Application.ScreenUpdating = False
 
sPath = "H:\AUTRE\SOPHIE\BASE GAD\EXTRACTION\"       'Répertoire
sFilename = Dir(sPath & "*.xls*")        'ouvre tous les fichiers .xls*
 
Do While Len(sFilename) > 0
Set wb2 = Workbooks.Open(sPath & sFilename)           'Ouvre le fichier
'
' Votre code ici
    NbRows = wb2.Sheets(2).Range("A60000").End(xlUp).Row  'Nb de lignes
Set rg = wb.Sheets(2).Range("A60000").End(xlUp).Offset(1, 0)
    rg = sFilename
    rg.Offset(0, 1) = NbRows
'
'
    wb2.Close False   'Fermer le fichier
    sFilename = Dir
 
Loop
Application.ScreenUpdating = True
 
End Sub
 
 
 
'------------------------------------------------------------------------------
' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' GCXL
'-------------------------------------------------------------------------------
Sub Creer_Recapitulatif()
Dim wbRecap As Workbook         'fichier recap
Dim wsRecap As Worksheet        'feuille où on écrit les données
Dim wbSource As Workbook        'fichier à ouvrir
Dim wsSource As Worksheet       'feuille où on cherche les données
Dim DernLign As Integer         'ligne où on écrit les données
Dim vFichiers As Variant        'noms des fichiers
Dim i As Integer, k As Integer
Dim rgRecap As Range            'plage où on copie les données
 
Set wbRecap = ThisWorkbook    'Fichier récapitulatif
Set wsRecap = wbRecap.Sheets("Data")  'on écrit dans la feuille DATA du fichier récapitulatif
 
' --- Ouvrir boite de dialogue pour sélectionner les fichiers à ouvrir
    vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler") 'Appel de Fonction pour ouvrir fichiers
 
' --- Vérifier qu'au moins un fichier à été sélectionné
If Not IsArray(vFichiers) Then
        Debug.Print "Aucun fichier sélectionné."
        MsgBox "Erreur! Aucun/Mauvais fichier sélectionné."
Exit Sub
End If
On Error Resume Next
 
    Application.ScreenUpdating = False
 
' --- Boucle à travers les fichiers
For k = 1 To UBound(vFichiers)
        Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
 
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' C'est ici qu'on écrit les instructions
Set wbSource = Workbooks.Open(vFichiers(k))                        'on ouvre le fichier
Set wsSource = wbSource.Sheets(2)                                  'On copie les données de la feuille 1
        DernLign = wbRecap.Sheets(2).Range("A60000").End(xlUp).Row + 1     'ligne pour écrire le log des fichiers compilés
 
' - On copie les données vers le fichier Recapitulatif; à adapter
Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
      '  rgRecap = Time
 
      wsSouce.Range("A1:AJ" & DerniereLigne).Copy
'With wsSource
        wsRecap.Range("A" & rgRecap).Select
 
             Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 '           rgRecap.Offset(0, 2) = .Range("B8")
  '          rgRecap.Offset(0, 3) = .Range("B10")
  '          rgRecap.Offset(0, 4) = .Range("B13")
    '        rgRecap.Offset(0, 5) = .Range("B14")
'End With
 
        wbSource.Close              'fermer fichier
Set wbSource = Nothing
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Next k
 
    Application.ScreenUpdating = True
    Application.StatusBar = False
 
End Sub '------------------------------------------------------------------------------
 
 
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
 
    sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
    bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
    Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function

[parmi]

Bonjour,

Quel est ton problème exactement ?

Je vois que tu essaies différentes méthodes pour l'ouverture de fichiers.
Est-ce là ton problème ?

Je vois aussi ceci

Code :

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

1
2
3
4
5
' - On copie les données vers le fichier Recapitulatif; à adapter
Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
      '  rgRecap = Time
 
      wsSouce.Range("A1:AJ" & DerniereLigne).Copy

Tu utilises DerniereLigne, mais je n'ai pas vu où cette variable a été initialisée... (peut-être mal vu...)
Ça doit te retourner une erreur, j'imagine (?)

[phoenix974]

Aucune de ces méthodes ne fonctionnent correctement, le mieux que j'ai réussi à faire c'est que le fichier s'ouvre mais des qu'il est ouvert le code ne continu pas mais j'ai pas forcement de message d'erreur.

Quand au code de Claude, il est un poil trop complexe pour moi pour le moment pour que j'arrive à l'adapter correctement.

Le but étant donc qu'il ouvre tous les fichiers soit sélectionné soit dans un répertoire donné peu importe (sachant qu'ils seront sur un réseau) de prendre toutes les données de l'onglet 2 nommé ("Data") sauf la première ligne et de tout coller dans l'onglet ("DataRecap") du fichier RECAP à la fin au niveau de la première ligne vide.

[phoenix974]

J'avance doucement, pour le moment j'arrive a faire en sorte que le fichier soit ouvert et que l'onglet soit copié dans mon fichier recap.

Rester à trouver comment faire en sorte qu'il copie toutes les lignes sauf la premiere à la fin de mon onglet Data du fichier recap.

Quel modification devrais je faire pour que l'utilisateur ai à choisir les fichiers à prendre en compte?

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
Sub Fichiers()
 
 
Dim chemin As String, filtre As String, Fichiers As String
Dim Fichier_Recap As String
 
  chemin = "D:\AUTRE\SOPHIE\BASE GAD\EXTRACTION\"
   filtre = "*.xlsx" ' ou le filtre que tu veux ... par exemple "*.txt" ou même "toto*.*"
   Fichiers = Dir(chemin & filtre, vbNormal Or vbHidden)
   Fichier_Recap = Dir(chemin & "GADD_Report_MATRICE_Test.xlsm", vbNormal Or vbHidden)
   Workbooks.Open chemin & Fichier_Recap
   Do While Fichiers <> "GADD_Report_MATRICE_Test.xlsm"
           Workbooks.Open chemin & Fichiers
        Workbooks(Fichiers).Sheets("Data").Copy After:=Workbooks(Fichier_Recap).Sheets("Data")
        Workbooks(Fichiers).Close
   'c'est ici que tu dois implanter ton ouverture et sauvegarde de ton fichier
 MsgBox Fichiers ' ici ca va t'affichier le nom de fichier
 Fichiers = Dir
   Loop
 
End Sub

[parmi]

J'avance doucement, pour le moment j'arrive a faire en sorte que le fichier soit ouvert et que l'onglet soit copié dans mon fichier recap.

Rester à trouver comment faire en sorte qu'il copie toutes les lignes sauf la premiere à la fin de mon onglet Data du fichier recap.

Désolé, mais je ne saisis pas trop ton histoire de ligne...
Quelle ligne veux-tu supprimer de l'onglet que tu as copié ?

Est-ce bien l'onglet que tu veux copier ou les données des fichiers que tu ouvres ?

[phoenix974]

La j'ai reussi à faire copier l'onglet.

Mais au final c'est pas l'onglet que je veux copier mais les données contenues dans cet onglet (sauf la ligne 1 contenant les entetes) et les coller dans mon fichier recap