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