Bonjour,
Je cherche à finaliser une macro vba sous excel qui permet de sélectionner plusieurs fichiers excel puis copier des cellules des fichiers sélectionnés et coller dans le fichier pilote qui contient la macro qui s’appelle « ouverture multi fichiers.xls ».
La macro fonctionne correctement avec le 1er fichier sélectionné puis bug pour le fichier suivant avec une erreur 424 sur l’instruction Workbooks.Open FileName:=NomduFichier(i).
Un GRAND Merci d’avance pour vos tuyo !
Jojo

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
Sub ChargementMultiFichiers()
    Dim Filt As String
    Dim FilterIndex As Integer
    Dim NomduFichier As Variant
    Dim Title As String
    Dim i As Integer
 
'   Descriptif extensions fichiers
    Filt = "Text Files (*.txt),*.txt," & _
            "Lotus Files (*.prn),*.prn," & _
            "Comma Separated Files (*.csv),*.csv," & _
            "ASCII Files (*.asc),*.asc," & _
            "All Files (*.*),*.*"
'   Display *.* by default
    FilterIndex = 5
'   Donne le titre de la boite de dialogue
    Title = "Selectionner le fichier"
'   Récupération des noms de fichiers
    NomduFichier = Application.GetOpenFilename _
        (FileFilter:=Filt, _
         FilterIndex:=FilterIndex, _
         Title:=Title, _
         MultiSelect:=True)
 
'   Exit si annule boite dialogue
    If Not IsArray(NomduFichier) Then
        MsgBox "Aucun fichier sélectionné."
        Exit Sub
    End If
 
'Renvoie le chemin et noms des fichiers sélectionnés
    For i = LBound(NomduFichier) To UBound(NomduFichier)
Workbooks.Open FileName:=NomduFichier(i)
Set NomduFichier = ActiveWorkbook 'Enregistre le nom du fichier ouvert
Range("A1:A10").Copy 'copie les cellules A1:A10 du fichier sélectionné
Windows("ouverture multi fichiers.xls").Activate
Sheets("Feuil1").Select
'recherche cellule vide et colle la sélection dans le fichier collecteur "ouverture multi fichiers.xls"
Range("A1").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
ActiveCell.Select
ActiveSheet.Paste
 
Application.DisplayAlerts = False
NomduFichier.Close SaveChanges:=False
Application.DisplayAlerts = True
 Next i
 End Sub