Discussion :

[Fayrouzam]

Bonjour tout le monde, j'ai un soucis dans mon code vba.

Et j'aimerais aussi s'avoir si la copie en vb me fera gagner plus de temps que celle manuellement, certes vb c'est plus pratique mais reste à comparer le temps que ça prend.

Dans un dossier, j'ai plusieurs fichier excel non vide du meme format. dont j'aimerais joindre les données dans un seul fichier pour une analyse ultérieure.

En effet je voudrais ouvrir un ou plusieurs fichiers excel ayant le même format,les copier et les coller à partir de la 3ème ligne d'un fichier récapitulatif.

J'ai effectué plusieurs tests, le tout marche bien sauf la partie de la copie. Ainsi j'ai essayé plusieurs syntaxes de copie mais en vain:

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
 
Dim wbDATA As Workbook         'fichier DATA
Dim wsDATA 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 wbDATA = ThisWorkbook       'Fichier récapitulatif
Set wsDATA = wbDATA.Worksheets("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 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)
 
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' les instructions
            Set wbSource = Workbooks.Open(vFichiers(k))                        'on ouvre le fichier
            Set wsSource = wbSource.Worksheets("det")                                  'On copie les données de la feuille det
            DernLign = wbDATA.Worksheets("det").Range("A60000").End(xlUp).Row + 1    
 
            For i = 1 To 55
                wbSource.wsSource.Range("A2").Copy wbDATA.wsDATA.Range("A4")
            Next i
 
            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

merci de votre aide!

[mercatog]

1. la copie se sera comme ceci:

Code :

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

1
2
3
4
For i = 1 To 55
   wsSource.Range("A2").Copy wsDATA.Range("A4")
Next i

2. Pourquoi 55 fois la même chose

[Fayrouzam]

J'ai oublier de copier le bout de code suivant:

Code :

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

1
2
3
4
 
For i = 1 To 55
    wsSource.Rows(i).Copy Destination:=wscopie.Rows(i)
Next i

Par lequel je voudrais faire une copie des 55 colonnes une par une de la 2ème ligne et les coller respectivement à partir de la 3ème ligne. Sauf que je n'y parvient pas

[mercatog]

Sans boucle

Code :

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

1
2
3
4
5
6
7
8
9
'.....
For k = 1 To UBound(vFichiers)
    Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
    Set wbSource = Workbooks.Open(vFichiers(k))                                'on ouvre le fichier
    Set wsSource = wbSource.Worksheets("det")                                          'On copie les données de la feuille det
    DernLign = wsDATA.Range("A60000").End(xlUp).Row + 1
 
    wsSource.Range("A2:A55").EntireRow.Copy wsDATA.Range("A" & DernLign)
'....

[Fayrouzam]

voici le nouveau code, il ne copie rien !
il ouvre les fichiers selectionnés et accomplit l'execution du programme mais ne copie rien

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
 
Sub Creer_Recapitulatif()
 
Dim wbDATA As Workbook         'fichier DATA
Dim wsDATA 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 wbDATA = ThisWorkbook       'Fichier récapitulatif
Set wsDATA = wbDATA.Worksheets("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)
 
    ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' les instructions
            Set wbSource = Workbooks.Open(vFichiers(k))                        'on ouvre le fichier
            Set wsSource = wbSource.Worksheets("det")                                  'On copie les données de la feuille det
            DernLign = wbDATA.Worksheets("det").Range("A60000").End(xlUp).Row + 1     'ligne pour écrire le log des fichiers compilés
            wsSource.Range("A2:A55").EntireRow.Copy wsDATA.Range("A" & DernLign)
 
    ' - On copie les données vers le fichier Recapitulatif; à adapter
    'Set rgRecap = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)
        'rgRecap = Time
    'With wsSource
 
            'rgRecap.Offset(0, 1) = .Range("B7")
            '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

[mercatog]

Testé comme ceci sans problème.

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
Sub Test()
Dim wsDATA 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 k As Integer
 
vFichiers = Selectionner_Fichiers("Sélectionner les fichiers à compiler")       'Appel de Fonction pour ouvrir fichiers
If IsArray(vFichiers) Then
    Application.ScreenUpdating = False
    Set wsDATA = ThisWorkbook.Worksheets("DATA")    
    With wsDATA
        For k = 1 To UBound(vFichiers)
            Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichiers)
            Set wbSource = Workbooks.Open(vFichiers(k))                        'on ouvre le fichier
            Set wsSource = wbSource.Worksheets("det")
            DernLign = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            wsSource.Range("A2:X55").Copy .Range("A" & DernLign)
 
            wbSource.Close False             'fermer fichier
            Set wbSource = Nothing
            Set wsSource = Nothing
        Next k
    End With
    Set wsDATA = Nothing
 
    Application.ScreenUpdating = True
    Application.StatusBar = False
Else
    MsgBox "Erreur! Aucun fichier sélectionné."
End If
End Sub