XL 2016 Utiliser La fonction GetOpenFilename

[KTM]

Bonsoir Famille Forum
Je voudrais importer des données dans mon classeur actif "Synth" depuis d'autres classeurs "class1;class2......"
J'utilise une macro pour le faire mais l'importation se fait classeur après classeur.
Je voudrais ajuster mon code de sorte à sélectionner un ou plusieurs classeurs à la fois et importer en un coup.

Sub Compil()
Dim fichie As Variant
Dim wkb1 As Worksheet
Dim shF As Worksheet
Dim classeur As Workbook
Application.ScreenUpdating = False
Sheets("PROT").Copy After:=Sheets("BASE")

Set shF = ThisWorkbook.Worksheets(2)
ChDir ActiveWorkbook.Path
fichie = Application.GetOpenFilename(Title:="Selectionnez le Fichier à Importer", filefilter:="Fichier Excel (*.xls*),*xlsx*", buttontext:="Cliquez")
Application.ScreenUpdating = False
If fichie <> False Then

                                Set classeur = Application.Workbooks.Open(fichie)
                                Application.ScreenUpdating = False
                                Set wkb1 = classeur.Worksheets(1)
                                
                                shF.Range("B1:E12").Value = wkb1.Range("B1:E12").Value
                                
                                shF.Name = wkb1.Range("B1")
                                classeur.Close SaveChanges:=False
                                ThisWorkbook.Worksheets("BASE").Activate
                                Sheets(2).Visible = True
End If

End Sub

 

[Staple1600]

Bonjour @KTM, le fil


[Pour infos]
Puisque Excel 2016, PowerQuery fait cela tout seul de manière ergonomique
(=> Données/Obtenir des données/A partir d'un dossier )

 

[KTM]

Bonjour @KTM, le fil


[Pour infos]
Puisque Excel 2016, PowerQuery fait cela tout seul de manière ergonomique
(=> Données/Obtenir des données/A partir d'un dossier )

Merci Mais je voudrais le faire par VBA pour le besoin si c'est possible !!

 

[Staple1600]

Re

Oui c'est possible (*)
mais je vais au plus simple

sélectionner un ou plusieurs classeurs à la fois et importer en un coup.

Avec Excel 2016, la fonction est native et se pilote à la souris
(et ne nécessite aucune connaissance VBA)
Avant de la rejeter, fais au moins un essai

(*) il suffit de faire une boucle
(cf les nombreux exemples à disposition dans les archives du forum
mots-clés
combiner classeurs

 

[Staple1600]

Re

Issu des archives, donc du VBA
Nous étions en 2019

XL 2019 - Besoin d'aide pour créer du code VBA - fusion de plusieurs fichiers avec report de nom sur les onglets

Bonjour, J'ai plusieurs fichiers excel, chaque fichier ne comprend qu'une seule page qui n'a pas de nom. J'aimerais compiler tous les fichiers dans un seul et que chaque onglet porte le nom du fichier d'origine. Exemple : admettons que j'ai 3 fichiers : test1, test2, test3, chaque fichier n'a...

excel-downloads.com

 

[patricktoulon]

bonsoir @KTM met la en multiselect ton dialog

Sub Compil()
    Dim fichie As Variant
    Dim wkb1 As Worksheet
    Dim shF As Worksheet
    Dim classeur As Workbook
    Application.ScreenUpdating = False
    Sheets("PROT").Copy After:=Sheets("BASE")

    Set shF = ThisWorkbook.Worksheets(2)
    ChDir ActiveWorkbook.Path
    fichie = Application.GetOpenFilename(FileFilter:=" Excel Files ( *.xlsx;*.xls;*.xlsm), ( *.xlsx;*.xls;*.xlsm), All Files, *.*", FilterIndex:=1, MultiSelect:=True, Title:="Selectionnez le ou les Fichier(s) à Importer")

    If Not IsArray(fichie) Then
        If fichie = False Then MsgBox "Sélection de fichier Annulée": Exit Sub Else fichie = Array(fichie)
    End If

    Application.ScreenUpdating = False
    For i = 1 To UBound(fichie)
        MsgBox fichie(i)
        Set classeur = Application.Workbooks.Open(fichie(i))
        Application.ScreenUpdating = False
        Set wkb1 = classeur.Worksheets(1)

        shF.Range("B1:E12").Value = wkb1.Range("B1:E12").Value

        shF.Name = wkb1.Range("B1")
        classeur.Close SaveChanges:=False
        ThisWorkbook.Worksheets("BASE").Activate
        Sheets(2).Visible = True
    Next
End Sub

 

[Staple1600]

Bonsoir @patrictoulon

Ou essaies le message#5

 

[patricktoulon]

bonsoir @Staple1600 on c'est croisés
a oui si tu veux le filedialog de excel
comme il est parti avec getopenfilename je suis resté avec ce dialog

 

[KTM]

bonsoir @KTM met la en multiselect ton dialog

Sub Compil()
    Dim fichie As Variant
    Dim wkb1 As Worksheet
    Dim shF As Worksheet
    Dim classeur As Workbook
    Application.ScreenUpdating = False
    Sheets("PROT").Copy After:=Sheets("BASE")

    Set shF = ThisWorkbook.Worksheets(2)
    ChDir ActiveWorkbook.Path
    fichie = Application.GetOpenFilename(FileFilter:=" Excel Files ( *.xlsx;*.xls;*.xlsm), ( *.xlsx;*.xls;*.xlsm), All Files, *.*", FilterIndex:=1, MultiSelect:=True, Title:="Selectionnez le ou les Fichier(s) à Importer")

    If Not IsArray(fichie) Then
        If fichie = False Then MsgBox "Sélection de fichier Annulée": Exit Sub Else fichie = Array(fichie)
    End If

    Application.ScreenUpdating = False
    For i = 1 To UBound(fichie)
        MsgBox fichie(i)
        Set classeur = Application.Workbooks.Open(fichie(i))
        Application.ScreenUpdating = False
        Set wkb1 = classeur.Worksheets(1)

        shF.Range("B1:E12").Value = wkb1.Range("B1:E12").Value

        shF.Name = wkb1.Range("B1")
        classeur.Close SaveChanges:=False
        ThisWorkbook.Worksheets("BASE").Activate
        Sheets(2).Visible = True
    Next
End Sub

Merci cela fonctionne mieux comme ci.
Mais aidez moi à gerer l'erreur si le classeur est deja importé.Merci

Sub Compil()
    Dim fichie As Variant
    Dim wkb1 As Worksheet
    Dim shF As Worksheet
    Dim classeur As Workbook
    Dim i As Long
    Application.ScreenUpdating = False
    ChDir ActiveWorkbook.Path
    fichie = Application.GetOpenFilename(FileFilter:=" Excel Files ( *.xlsx;*.xls;*.xlsm), ( *.xlsx;*.xls;*.xlsm), All Files, *.*", FilterIndex:=1, MultiSelect:=True, Title:="Selectionnez le ou les Fichier(s) à Importer")

    If Not IsArray(fichie) Then
        If fichie = False Then MsgBox "Sélection de fichier Annulée": Exit Sub Else fichie = Array(fichie)
    End If

    Application.ScreenUpdating = False
    For i = 1 To UBound(fichie)
         Sheets("PROT").Copy After:=Sheets("BASE")
         Set shF = ThisWorkbook.Worksheets(2)
         Set classeur = Application.Workbooks.Open(fichie(i))
         Application.ScreenUpdating = False
         Set wkb1 = classeur.Worksheets(1)
         shF.Range("B1:E12").Value = wkb1.Range("B1:E12").Value
         shF.Name = wkb1.Range("B1")
         classeur.Close SaveChanges:=False
         ThisWorkbook.Worksheets("BASE").Activate
         Sheets(2).Visible = True
    Next

End Sub