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

XL 2016 Utiliser La fonction GetOpenFilename

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion KTM
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
KTM

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

Trier par date Trier par votes
Re

Oui c'est possible (*)
mais je vais au plus simple
sélectionner un ou plusieurs classeurs à la fois et importer en un coup.
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
Vote positif 0 Vote négatif
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
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
176
telemarrk
T
N
  • Résolu(e)
XL 2019 Aide macro on error resume
Réponses
3
Affichages
541
netparty
N
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Y
  • Résolu(e)
XL 2016 Fonction GetSaveAsFilename pour enregistrer une extraction
Réponses
3
Affichages
1 K
YANNISE
Y
S
  • Résolu(e)
Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date
Réponses
8
Affichages
1 K
Sylvain. B
S
A
  • Question Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
928
A-F
A
S
  • Question Question
Aide sur La fin d'une Macro SVP
Réponses
3
Affichages
731
sylvanu
Z
  • Question Question
Microsoft 365 Changement de la valeur d'une cellule en fonction de la valeur d'une autre cellule
Réponses
7
Affichages
846
Zifox
Z
  • Question Question
XL 2021 import-informations-classeurs-fermes
2 3
Réponses
40
Affichages
4 K
Usine à gaz
A
  • Question Question
XL 2010 importer et exporter des données à des fichiers excel
Réponses
9
Affichages
2 K
job75
  • Question Question
XL 2019 Pb de retour au classeur de la macro
Réponses
2
Affichages
709
Spitnolan08
S
  • Question Question
XL 2016 VBA Synthèse Classeur Volumineux + Comparaison
2
Réponses
16
Affichages
3 K
scalaze
S
S
  • Résolu(e)
Microsoft 365 automatiser macro pour copier/coller des données d´un classeur à un autre et sauver à chaque fois le classeur rempli
Réponses
8
Affichages
4 K
sevenkingdom
S
  • Question Question
Microsoft 365 adapter l'excellent code de Job75
2
Réponses
16
Affichages
3 K
Usine à gaz
D
  • Résolu(e)
XL 2016 Utilisation de la fonction Me.Controls
2 3 4
Réponses
49
Affichages
8 K
dayyoni
D
R
  • Question Question
XL 2016 Macro pour compiler fichiers excel + Macro pour empiler tableaux
2
Réponses
15
Affichages
5 K
razorlight
R
B
  • Question Question
Regrouper différents onglets identiques sur un seul fichier et onglet
Réponses
6
Affichages
1 K
Bianchi
B
S
  • Question Question
XL 2013 Simplification de code
Réponses
5
Affichages
1 K
sr94
S
B
  • Question Question
boucle
Réponses
2
Affichages
852
BIL boud
B
  • Question Question
VBA-boucle: copier datas entre fichiers (1 WBKmaster/+ WBKfeeders) si WKS.Name sont =
Réponses
3
Affichages
1 K
zebanx
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…