Discussion :

[Geprocor]

Bonjour,

Je possède un dossier ("mon_dossier") qui contient "n" fichiers excel (aillant tous la même architecture).
Je souhaite récupérer, dans la feuille "ma feuille," les lignes non-vides (de la ligne 7 à dernière non-vides) des colonnes A à X de tous ces fichiers tout en les laissant fermés.
C'est lignes ainsi récupérées devront s'incrémenter les unes à la suite des autres afin de ne constituer qu'un seul fichier.

Voici ce que j'ai trouvé en fouillant un peu.

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
'Source : Frédéric Sigonneau
 
Sub LitDatas()
Dim Fich$, Arr
 
    Fich = "C:\Documents and Settings\mon dossier\fichier test.XLS"
 
  'récup des données à partir de l'adresse d'une plage de cellules
  GetExternalData Fich, "ma feuille", "A7:X65536", False, Arr
 
  'récup des données à partir du nom d'une plage de cellules ()
'  GetExternalData Fich, "", "plagenommée", False, Arr
 
  With ThisWorkbook.Sheets("Feuil1")
    .Range("A1", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
  End With
 
End Sub
 
'renvoie les valeurs d'une plage de cellules contigües (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) fermé
'dans un tableau (outArr)
'le paramètre TTL indique si la plage a ou non une ligne d'entêtes
 
Sub GetExternalData(srcFile As String, _
                    srcSheet As String, _
                    srcRange As String, _
                    TTL As Boolean, _
                    outArr As Variant)
'd'après Héctor Miguel, mpep
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Arr
 
  Set myConn = New ADODB.Connection
  If TTL = True Then HDR = "Yes" Else HDR = "No"
  myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & srcFile & ";" & _
              "Extended Properties=""Excel 8.0;" & _
              "HDR=" & HDR & ";IMEX=1;"""
  Set myCmd = New ADODB.Command
  myCmd.ActiveConnection = myConn
  If srcSheet = "" _
    Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
    Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
  Set myRS = New ADODB.Recordset
  myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
  ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
  myRS.MoveFirst
  Do While Not myRS.EOF
    For RS_n = 1 To myRS.RecordCount  'lignes
      For RS_f = 0 To myRS.Fields.Count - 1  'colonnes
        Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
      Next
      myRS.MoveNext
    Next
  Loop
  myConn.Close
  Set myRS = Nothing
  Set myCmd = Nothing
  Set myConn = Nothing
 
  outArr = Arr
 
End Sub

Le code fonctionne bien et je récupère bien les lignes (7 à 66536) du "fichier test".
Maintenant, je cherche à récupérer QUE les lignes non-vides et surtout à pouvoir incrémenter.

Il doit y avoir quelques choses comme ça à rajouter mais je n'y arrive pas :

Code :

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

1
2
' pour faire ma selection de ligne 7 à non-vide
Range(Selection, Selection.End(xlDown)).Select

Code :

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

1
2
3
' pour lire tous les fichiers xls de "mon dossier"
Repertoire = "C:\Documents and Settings\\mon dossier\"
Fichier = Dir(Repertoire & "*.xls")

Je suis "ultra débutant" en VBA donc je ne sais pas si tout celà est compatible...

Un petit plus serait de pouvoir commencer cette compilation à la ligne 2 afin de mettre les entêtes de colonne sur la ligne 1.

J'espère que j'ai bien expliquer ce que je souhaite.

Merci d'avance pour vos contributions

Mathieu

[SilkyRoad]

bonsoir

pour boucler sur les classeurs du répertoire :
Comment fusionner tous les classeurs fermés d'un répertoire, à la suite dans une nouvelle feuille de calcul ?

Pour ce qui est de filtrer les lignes vides, il faudrait peut être ajouter une clause WHERE dans la requete, mais difficile d'etre plus précis sans voir le contenu de ton classeur.


bonne soirée
michel

[Lufia]

Bonjour!

J'ai eu un projet semblable dernièrement et on m'a donné un code très intéressant. Il permet d'ouvrir tous les fichier ".xls" d'un dossier donné et de faire une action (ici copier des lignes vers un autre fichier). Il faut seulement faire attention que le fichier de destination ne soit pas dans le meme dossier que les fichiers d'où proviennent les donné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
Sub OuvreFichier()
Dim WkRecap As Workbook
Dim WkMensuel As Workbook
 
Set WkRecap = ThisWorkbook
Range("A3").Select 'sélectionner la cellule de début
'saisir le chemin complet du dossier où se trouvent les fichiers
Chemin = "C:\Chemin"
fichier = Dir(Chemin & "*.xls") ' Premier fichier à ouvrir
    Do While fichier <> ""
            Set WkMensuel = Workbooks.Open(Filename:=Chemin & fichier)
            WkMensuel.Worksheets("Feuil1").Select
            Range("A3:D600").Copy 'Incrire le range à copier
            WkRecap.ActiveSheet.Paste
            WkMensuel.Activate
            Application.CutCopyMode = False
            WkMensuel.Close savechanges:=False
            WkRecap.ActiveSheet.Cells WkRecap.ActiveSheet.UsedRange.Rows.Count + 1, 1).Select
    fichier = Dir ' Fichier suivant
    Loop
End Sub

Il te faudra bien entendu l'adapter, mais je crois que ça pourrait t'être utile.

Bonne journée!

[Geprocor]

Bonjour,

d'abord merci...

J'ai testé vos 2 solutions.
Celle de Michel me conviendrait mieux car elle utilise la bibliothèque ADO alors que celle de Lufia m'ouvre les fichiers pour "copier coller" (mais merci en tous cas).

La solution de Michel fonctionne mais je sais pas quels paramètres modifier pour :
- commencer mon nouveau classeur à la ligne 2 (je suppose qu'il s'agit de "i=2")
- récupérer uniquement les lignes 7 à la dernière ligne "pleine" (il doit y avoir un End(xlDown).Row à ajouter quelque part)

En fichier attaché, voici un exemple de "fichier source" à traiter.

Merci encore

[Geprocor]

Un petit coups de pouce s'il vous plait...

Je ne suis plus très loin du but, mais je ne trouve pas

J'ai trouvé ça :

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
'Source ouskel'n'or
Public msg As String
 
Sub Appel() 'A ADAPTER
Dim Chemin As String
    Application.ScreenUpdating = False
        Chemin = "C:\Documents and Settings\Mon Dossier\"
        Ouvrir Chemin
    Application.ScreenUpdating = True
    If msg <> "" Then _
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub
 
Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
    Application.DisplayAlerts = False 'Evite les messages d'Excel
    'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
    Application.EnableEvents = False
        NomFich = Dir(Chemin & "*.xls")
        If NomFich = "" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin
             Exit Sub
        End If
        Do While NomFich <> ""
            Set CL2 = Workbooks.Open(Chemin & NomFich)
            DoEvents
            Copie CL2
            CL2.Close False
            DoEvents
            ThisWorkbook.Save 'enregistrement du classeur après chaque copie
            DoEvents
            NomFich = Dir
        Loop
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub
 
Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
    Set FL1 = ThisWorkbook.Worksheets("Feuil1")
        For Each LaFeuille In CL2.Worksheets 'feuille où les données sont collées
        'On vérifie que la feuille n'est pas vide
        If Not (LaFeuille.UsedRange.Address = "$A$7" And Range("A7") = "") Then
            derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
            On Error Resume Next
            LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
            End If
        End If
    Next
End Sub

Comment ne sélectionner que les lignes 7 à "derlig" de ma feuille nommé "ma_feuille" ?

Merci

[Geprocor]

C'est bon, j'ai réussi.

Bon, les fichiers s'ouvrent, mais c'est relativement rapide...

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
Sub Compilation()
 
Dim Fichier As String
Dim Chemin As String
Dim ClasseurSource As Workbook
 
 
Application.DisplayAlerts = False 'Evite les messages d'Excel
Application.EnableEvents = False 'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
 
Chemin = "C:\Documents and Settings\Mon_Dossier\" 'Chemin du répertoire contenant les fichiers
Fichier = Dir(Chemin & "*.xls")
 
Do While Fichier <> ""
    Set ClasseurSource = Workbooks.Open(Chemin & Fichier)
    ClasseurSource.Worksheets("Ma_Feuille").Select 'nom de la feuille source (commune à tous les fichiers sources)
    Range("A7:X7").Select
    Range("X7").Activate
    Range(Selection, Selection.End(xlDown)).Select 'selection de la zone à copier
    Selection.Copy
    ThisWorkbook.Activate
    Sheets("Feuil1").Select
    Cells(65535, 1).End(xlUp)(2).Select 'recherche de la première ligne vide
    ActiveSheet.Paste
    ClasseurSource.Close
    Fichier = Dir
Loop
 
Application.EnableEvents = True
Application.DisplayAlerts = True
 
End Sub

Voilà si certains sont intéressés.

[Hamouda7542]

Bonjour à toutes et à tous,
Pouvez vous adapter cette macro à ma problèmatique SVP?


J'ai besoin d'une macro qui puisse Compiler une feuille presente dans plusieurs fichiers (et non pas toutes les feuilles).

Ex: Fichier "ARENTINE" prendre la feuille DATA BASE--> cellules (A2:T3561)
Fichier "BRESIL" prendre la feuille DATA BASE--> cellules (A2:T3561)
Fichier "UKRAINE prendre la feuille DATA BASE--> cellules (A2:T3561)

Etc
Toutes ces données doivent être compiler à la suite dans un fichier nommé "COMPIL"


En vous remerciant par avance de votre aide