Aide pour la mise en oeuvre de GetOpenFileName

  • Initiateur de la discussion Initiateur de la discussion sebgo
  • 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 !

sebgo

XLDnaute Occasionnel
Bonjour le forum

Avec l'aide du forum, j'ai pu réaliser une macro d'importation de données d'un classeur excel vers le classeur cible. (un coucou à Bernard pour son aide). Il marche avec la contrainte que le fichier soit ouvert. Or je voulais passer par la méthode GetOpenFileName pour sélectionner le nom du fichier dans un repertoir sans forcément l'ouvrir au préalable. Mais je bute sur cette méthode. Je joint le code pour toute adaptation possible.

Sub TransfertDonneesFeuille()
Dim Classeur As String, Feuille As String
Dim Lig As Integer, MyValue As Byte, Ws As Object

MyValue = MsgBox("Souhaitez-vous effectuer un transfert de données ?", vbYesNo + vbCritical + vbDefaultButton2, "DECISION DE TRANSFERT")
If MyValue = vbNo Then Exit Sub
' Affiche le message de saisie du nom du classeur source
Do
Classeur = InputBox("Veuillez entrer le Nom du classeur source !", _
"ORIGINE DES DONNEES", "Nom") ' Valeur de la variable.
If Classeur = "Nom" Or Classeur = "" Then
'Message de vérification de décision d'annuler le transfert de données
MyValue = MsgBox("Souhaitez-vous annuler le transfert de données ?", _
vbYesNo + vbCritical + vbDefaultButton1, "DECISION DE TRANSFERT")
If MyValue = vbYes Then Exit Sub
End If
Loop Until Classeur <> "" And Classeur <> "Nom"
' Mise en forme
Classeur = Classeur & ".xls"
' Boucle sur les feuilles du classeur
For Each Ws In Workbooks(Classeur).Worksheets
If Ws.Range("A2") <> "" Then ' Cellule de recherche de données
'Dernière ligne du classeur cible
Lig = ThisWorkbook.Sheets("Kits").Range("A65000").End(xlUp).Row
' Transfert des données d'une plage du classeur source sur le classeur cible
Workbooks(Classeur).Sheets(Ws.Name).Range("A2:F10000 ").Copy
ThisWorkbook.Sheets("Kits").Range("A" & Lig + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
End If
Next Ws
End Sub

Merçi par avance
Sebgo
 
- 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

  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
171
Réponses
4
Affichages
223
Réponses
3
Affichages
673
Retour