Discussion :

[yoshitsune]

Bonjour,

premièrement je débute en VBA. Si vous connaissez un bon tutoriel, pourriez vous me l'indiquer? Merci

Deuxièmement: voici mon problème.
J'ai de multiples fichiers excel qui ont tous la même architecture mais un nombre de lignes différent (et parfois un nombre de colonnes différent mais ceci pourrait être géré manuellement sans être problématique).
Les informations qui m'intéressent commencent à la ligne 13 et la colonne B
Elles se terminent à la première ligne vide qui est à un numéro de ligne variable X
Pour l'exemple, la dernière colonne qui m'intéresse est la ligne AR.

Il y a des cellules vides et d'autres non vides avant la cellule B13.
Il y a des cellules vides et d'autres non vides après la première ligne vide X.

Ce que je veux faire:
Ouvrir un fichier source 1
Copier toutes les cellules de B13 à ARX1
Coller ces données dans un fichier de synthèse
Fermer le fichier source
Ouvrir un second fichier source 2
Copier toutes les cellules de B13 à ARX2
Coller ces données dans un fichier de synthèse à la suite des données copiées précédemment
etc pour tous les fichiers sélectionnés.

J'ai trouvé ce bout de code que j'ai essayé d'adapter à mon besoin mais je n'ai pas réussi.

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
'------------------------------------------------------------------------------
' 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(1)  'on écrit dans la feuille 1 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(3)                                  'On copie les données de la feuille 3
        DernLign = wbRecap.Sheets(3).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 = vFichiers(k)
With wsSource
            rgRecap.Offset(0, 1) = .Range("B13", Range("B13").End(xlToDown)) 'Pour copier les données de la colonne B à partir de la cellule B13
 
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

Voilà, si vous pouviez me donner quelques pistes pour avancer ça serait super sympa car je suis perdu.

Merci,
Thomas.

[Theze]

Bonjour,

Une piste. Exécuter la Sub "Test" après avoir collé le code ci-dessous dans un module standard du classeur de synthèse, tous les classeurs étant dans le même dossier que celui du classeur de synthèse, commentaires dans le code :

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
 
Sub Test()
 
    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Plage As Range
    Dim Chemin As String
    Dim Lig As Long
    Dim I As Integer
 
    'les fichiers sont dans le même dossier que le classeur de synthèse
    Chemin = ThisWorkbook.Path & "\"
 
    'appel de la fonction pour récupérer les noms des fichiers
    Tbl = RecupFichiers(Chemin)
 
    If Not Not Tbl Then
 
        For I = 1 To UBound(Tbl)
 
            'évite de prendre en compte ce classeur
            '(son nom est retourné par la fonction puisqu'ils sont tous dans le même dossier)
            If Dir(Tbl(I)) <> ThisWorkbook.Name Then
 
                'ouverture de tous les classeurs...
                Set Cls = Workbooks.Open(Tbl(I))
 
                'défini la plage à partir de B13
                With Cls.Worksheets("Feuil1")
 
                    Set Plage = .Range(.Cells(13, 2), _
                                .Cells(.Cells.Find("*", .[A1], -4123, , _
                                1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                                2, 2).Column))
 
                End With
 
                With ThisWorkbook.Worksheets("Feuil1")
 
                    Lig = .Cells(.Rows.Count, 1).End(xlUp).Row  'sur colonne A
                    If Lig > 1 Then Lig = Lig + 1
 
                    'récup des valeurs
                    .Range(.Cells(Lig, 1), .Cells(Lig + Plage.Rows.Count - 1, Plage.Columns.Count)).Value = Plage.Value
 
                End With
 
                'fermeture sans enregistrement
                Cls.Close False
 
            End If
 
        Next I
 
    End If
 
End Sub
 
Function RecupFichiers(Chemin As String) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*.xls*") 'si seuls les.xlsx sont voulus,mettre "*.xlsx"
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Chemin & Fichier
 
        Fichier = Dir()
 
    Loop
 
    RecupFichiers = TableauFichiers()
 
End Function

[3Y Njoya]

Bonsoir,

Je débute en VBA. SVP donnez moi le code pour activer le comboboxMod et le bouton modifier dans mon classeur ci-joint (Stock6)
Merci d'avance.

[yoshitsune]

Merci Theze,

ça marche super bien!
2 modifications que je voudrais apporter pour optimiser:
-Dans les fichiers dont il faut extraire des données, il y a des données qui ne m'intéressent pas en dessous de la première ligne vide. Il y a t-il moyen de ne pas copier ces données? Pour l'instant elles sont copiées dans le fichier de synthèse. Bizarrement la copie s'arrête à la seconde ligne vide.
-Je voudrais insérer le nom du fichier dont les données sont extraites dans la colonne A du fichier de synthèse pour l'avoir à côté des données extraites pour facilement s'y retrouver. Je vais essayer de le faire de mon côté.

[yoshitsune]

Bon et bien non je n'y arrive pas. J'ai essayé d'ajouter la ligne de code suivante pour récupérer le nom du fichier et le coller dans la première colonne mais ça ne marche pas.
".Range(.Cell(Lig, 1)).Value = Tbl(I)"

Code entier ci-dessous

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
 
Sub Test()
 
    Dim Tbl() As String
    Dim Cls As Workbook
    Dim Plage As Range
    Dim Chemin As String
    Dim Lig As Long
    Dim I As Integer
 
    'les fichiers sont dans le même dossier que le classeur de synthèse
    Chemin = ThisWorkbook.Path & "\"
 
    'appel de la fonction pour récupérer les noms des fichiers
    Tbl = RecupFichiers(Chemin)
 
    If Not Not Tbl Then
 
        For I = 1 To UBound(Tbl)
 
            'évite de prendre en compte ce classeur
            '(son nom est retourné par la fonction puisqu'ils sont tous dans le même dossier)
            If Dir(Tbl(I)) <> ThisWorkbook.Name Then
 
                'ouverture de tous les classeurs...
                Set Cls = Workbooks.Open(Tbl(I))
 
                'défini la plage à partir de B13
                With Cls.Worksheets("Full Datas")
 
                    Set Plage = .Range(.Cells(13, 2), _
                                .Cells(.Cells.Find("*", .[A1], -4123, , _
                                1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                                2, 2).Column))
 
                End With
 
                With ThisWorkbook.Worksheets("Feuil1")
                    Lig = .Cells(.Rows.Count, 2).End(xlUp).Row  'sur colonne B
                    If Lig > 1 Then Lig = Lig + 1
 
                    'récup des valeurs
                    .Range(.Cell(Lig, 1)).Value = Tbl(I)
                    .Range(.Cells(Lig, 2), .Cells(Lig + Plage.Rows.Count - 1, Plage.Columns.Count)).Value = Plage.Value
 
                End With
 
                'fermeture sans enregistrement
                Cls.Close False
 
            End If
 
        Next I
 
    End If
 
End Sub
 
Function RecupFichiers(Chemin As String) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*.xls*") 'si seuls les.xlsx sont voulus,mettre "*.xlsx"
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Chemin & Fichier
 
        Fichier = Dir()
 
    Loop
 
    RecupFichiers = TableauFichiers()
 
End Function