Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Utiliser La fonction GetOpenFilename

KTM

XLDnaute Impliqué
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.
VB:
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
 

Pièces jointes

  • class1.xlsx
    8.9 KB · Affichages: 2
  • class2.xlsx
    8.9 KB · Affichages: 0
  • class3.xlsx
    9 KB · Affichages: 0
  • Synth.xlsm
    18.9 KB · Affichages: 1

Staple1600

XLDnaute Barbatruc
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

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc
bonsoir @KTM met la en multiselect ton dialog
VB:
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
 

KTM

XLDnaute Impliqué

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

VB:
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…