Discussion :

[mammmy]

Salut tout le monde,
Est ce que quelqu'un sait comment faire avec du code VBA excel pour avoir le nom du fichier copié dans les cellules de la première colonne????

Au fait, je copie plusieurs fichiers excel dans un seul et je voudrais avoir à chaque fois le nom du fichier copié dans la cellule de la première colonne.

Merci d'avance

[fring]

Bonjour,

Tu les copies comment ces données de différents fichiers, manuellement ou par VBA ?

[mammmy]

Par vba.

[fring]

donc...dans ton code tu spécifies quelque part le nom du fichier duquel tu vas extraire les données ?

Montre ton code stp

[mammmy]

Je spécifie le répertoire où sont stockés les fichiers excel à copier. Voici 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
Sub Assemble()
Dim CL1 As Workbook, CL2 As Workbook 'classeur
Dim FL1 As Worksheet, FL2 As Worksheet 'feuille de calcul
Dim Fich As Variant, i As Byte, j$, Rep$, k As Long
 
 
    'Répertoire des fichiers à copier
    Rep = "C:\Documents and Settings\Bureau\test\"
    j = "fich1.xls"
    NomFichier = ActiveWorkbook.Name
    Set CL1 = ThisWorkbook
 
    'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
    CL1.Sheets.Add
    CL1.ActiveSheet.Name = "Cumul_Budget"
 
    Set FL1 = CL1.ActiveSheet 'Instance le la feuille
 
    'Crée le tableau des fichiers du répertoire
    Set Fich = application.FileSearch
 
    'Ouverture des fichiers du répertoire
    With Fich
        .LookIn = Rep
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                DoEvents
 
                'Parcours des feuilles de chaque classeur
                For Each FL2 In CL2.Worksheets
 
                    'Dernière ligne où coller les données copiées dans FL2
                    NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1

Et donc pas vraiment le fichier exactement car c'est une boucle.

[fring]

Code :

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

1
2
3
4
For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                NomClasseur = CL2.Name
                DoEvents

NomClasseur contiendra...le nom du classeur

Concernant la recherche de la dernière ligne, je te conseille de procéder autrement, SpecialCells(xlCellTypeLastCell) risque un jour de t'envoyer au fond de la cave.

Code :

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

NoLigne = FL1.Range("A65535").End(xlUp).Row + 1

[mammmy]

Merci beaucoup pour vos conseils et vos réponses.
Mais dites moi si ce qui suit est bien juste (je suis débutant en VBA )
Donc

Code :

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

1
2
3
4
5
6
7
8
9
10
'Ouverture des fichiers du répertoire
    With Fich
        .LookIn = Rep
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                NomClasseur = CL2.Name
                DoEvents

Et récuperer NomClasseur dans la colonne A, je fais:

Code :

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

1
2
3
4
5
6
7
'Affichage du nom de fichier
                [A6] = NomClasseur
 
                'fermeture du classeur copié
                CL2.Close False
                DoEvents
                Set CL2 = Nothing

est ce que c'est juste ou pas?
Merci

[fring]

Oui cela me semble correct, ou tu peux te passer de la variable NomClasseur et directement faire :

Code :

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

[A6] = CL2.Name

Attention que en l'écrivant comme ça il va inscrire le nom du classeur CL2 dans la cellule A6 de la feuille active du classeur actif.

Il vaut mieux écrire

Code :

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

FL1.Range("A6") = CL2.Name

[mammmy]

Merci pour votre aide.
Effectivement, il faut faire:

Code :

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

FL1.Range("A6") = CL2.Name

Mais j'ai un souci, car au fait il me met dans la cellule A6, le nom du dernier fichier copié. Alors que je veux à chaque qu'il copie un fichier qu'il me met son nom dans la colonne A cad il copie le fich1.xls me met dans la cellule A6 (car les données de mon fichier commence à la cellule A6) ensuite, il copie fich2.xls, il me met dans la cellule de la ligne où il l'a commencé à copier son nom...
Comment je peux avoir ça s'il vous plait.

Merci

[fring]

Le mieux serait de montrer la totalité de ton code pour que je puisse donner une réponse en fonction de ta manière de procéder

[mammmy]

Ok, et merci.
Voici mon 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
Sub Assemble()
Dim CL1 As Workbook, CL2 As Workbook 'classeur
Dim FL1 As Worksheet, FL2 As Worksheet 'feuille de calcul
Dim Fich As Variant, i As Byte, j$, Rep$, k As Long
 
 
    'Répertoire des fichiers à copier
    Rep = "C:\Documents and Settings\Bureau\test\"
    j = "fich1.xls"
    Set CL1 = ThisWorkbook
 
    'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
    CL1.Sheets.Add
    CL1.ActiveSheet.Name = "Cumul_Budget"
 
    Set FL1 = CL1.ActiveSheet 'Instance le la feuille
 
    'Crée le tableau des fichiers du répertoire
    Set Fich = application.FileSearch
 
    'Ouverture des fichiers du répertoire
    With Fich
        .LookIn = Rep
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                DoEvents
 
                'Parcours des feuilles de chaque classeur
                For Each FL2 In CL2.Worksheets
 
                    'Dernière ligne où coller les données copiées dans FL2
                    NoLigne = FL1.Range("A65535").End(xlUp).Row + 1
If j = "fich1.xls" Then
                        FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        j = ""
 
                    Else
                        FL2.Range("A5:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                    End If
 
                    'Affichage du nom de fichier
                    FL1.Range("A6") = CL2.Name
 
                    DoEvents
 
                    Set FL2 = Nothing
                Next
 
                'fermeture du classeur copié
                CL2.Close False
                DoEvents
                Set CL2 = Nothing
 
               'suppression des blancs en ligne et en colonne
                Range(Cells(Cells.Find("*", , , , xlByColumns, xlPrevious).Column + 1), Cells(1, 254)).EntireColumn.Delete
                Range(Cells(Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1, 1), Cells(65536, 1)).EntireRow.Delete
                ActiveSheet.UsedRange.Select
 
            Next i
Else
            MsgBox "Aucun fichier dans le répertoire " & Rep
        End If
    End With
End Sub

[fring]

Essaye ceci,

J'ai ajouté 2 lignes de code pour inscrire le nom du classeur dans la colonne B

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
Sub Assemble()
Dim CL1 As Workbook, CL2 As Workbook 'classeur
Dim FL1 As Worksheet, FL2 As Worksheet 'feuille de calcul
Dim Fich As Variant, i As Byte, j$, Rep$, k As Long
 
 
    'Répertoire des fichiers à copier
    Rep = "C:\Documents and Settings\Bureau\test\"
    j = "fich1.xls"
    Set CL1 = ThisWorkbook
 
    'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
    CL1.Sheets.Add
    CL1.ActiveSheet.Name = "Cumul_Budget"
 
    Set FL1 = CL1.ActiveSheet 'Instance le la feuille
 
    'Crée le tableau des fichiers du répertoire
    Set Fich = Application.FileSearch
 
    'Ouverture des fichiers du répertoire
    With Fich
        .LookIn = Rep
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                DoEvents
 
                'Parcours des feuilles de chaque classeur
                For Each FL2 In CL2.Worksheets
 
                    'Dernière ligne où coller les données copiées dans FL2
                    NoLigne = FL1.Range("A65535").End(xlUp).Row + 1
                    If j = "fich1.xls" Then
                        FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        FL1.Range("B" & NoLigne) = CL2.Name '<-- Affichage du nom de fichier
                        j = ""
 
                    Else
                        FL2.Range("A5:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        FL1.Range("B" & NoLigne) = CL2.Name '<-- Affichage du nom de fichier
                    End If
 
                    DoEvents
 
                    Set FL2 = Nothing
                Next
 
                'fermeture du classeur copié
                CL2.Close False
                DoEvents
                Set CL2 = Nothing
 
               'suppression des blancs en ligne et en colonne
                Range(Cells(Cells.Find("*", , , , xlByColumns, xlPrevious).Column + 1), Cells(1, 254)).EntireColumn.Delete
                Range(Cells(Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1, 1), Cells(65536, 1)).EntireRow.Delete
                ActiveSheet.UsedRange.Select
 
            Next i
        Else
            MsgBox "Aucun fichier dans le répertoire " & Rep
        End If
    End With
End Sub

[mammmy]

Merci ça marche.
Une dernière petite question comment copier le nom dans toutes les cellules des lignes qui appartiennent à ce fichier????
j'ai essayé ça mais ça me donne une erreur:

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
If j = "fich1.xls" Then
                        FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        li = AtteindreDerniereLigne(2, "B6")
                        For NoLigne = 6 To li
                        FL1.Range("B" & NoLigne) = CL2.Name '<-- Affichage du nom de fichier
                        j = ""
 
                    Else
                        FL2.Range("A5:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        li = AtteindreDerniereLigne(2, "B6")
                        For NoLigne to li
                        FL1.Range("B" & NoLigne) = CL2.Name '<-- Affichage du nom de fichier
                    End If

[fring]

Là j'y vais un peu à l'aveuglette, essaye ceci:

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
Sub Assemble()
Dim CL1 As Workbook, CL2 As Workbook 'classeur
Dim FL1 As Worksheet, FL2 As Worksheet 'feuille de calcul
Dim Fich As Variant, i As Byte, j$, Rep$, k As Long
 
 
    'Répertoire des fichiers à copier
    Rep = "C:\Documents and Settings\Bureau\test\"
    j = "fich1.xls"
    Set CL1 = ThisWorkbook
 
    'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
    CL1.Sheets.Add
    CL1.ActiveSheet.Name = "Cumul_Budget"
 
    Set FL1 = CL1.ActiveSheet 'Instance le la feuille
 
    'Crée le tableau des fichiers du répertoire
    Set Fich = Application.FileSearch
 
    'Ouverture des fichiers du répertoire
    With Fich
        .LookIn = Rep
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                DoEvents
 
                'Parcours des feuilles de chaque classeur
                For Each FL2 In CL2.Worksheets
 
                    'Dernière ligne où coller les données copiées dans FL2
                    NoLigne = FL1.Range("A65535").End(xlUp).Row + 1
                    If j = "fich1.xls" Then
                        FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        FL1.Range("B" & NoLigne & ":B" & FL1.Range("A65535").End(xlUp).Row) = CL2.Name '<-- Affichage du nom de fichier
                        j = ""
 
                    Else
                        FL2.Range("A5:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                        FL1.Range("A" & NoLigne)
                        FL1.Range("B" & NoLigne & ":B" & FL1.Range("A65535").End(xlUp).Row) = CL2.Name '<-- Affichage du nom de fichier
                    End If
 
                    DoEvents
 
                    Set FL2 = Nothing
                Next
 
                'fermeture du classeur copié
                CL2.Close False
                DoEvents
                Set CL2 = Nothing
 
               'suppression des blancs en ligne et en colonne
                Range(Cells(Cells.Find("*", , , , xlByColumns, xlPrevious).Column + 1), Cells(1, 254)).EntireColumn.Delete
                Range(Cells(Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1, 1), Cells(65536, 1)).EntireRow.Delete
                ActiveSheet.UsedRange.Select
 
            Next i
        Else
            MsgBox "Aucun fichier dans le répertoire " & Rep
        End If
    End With
End Sub

[mammmy]

Ok, ben merci.
Dommage, ça ne marche pas.
Je vais continuer à chercher.
Merci en tout cas

[fring]

Etrange, je viens de bricoler un bout de fichier pour pouvoir tester et ça fonctionne, j'obtiens bien le nom de fichier sur chaque ligne