Re : Transférer plage de données macro
Bonjour Sebgo,
Une macro à placer dans le fichier "Appli". Un message demande le nom du classeur source, celui-ci est supposé ouvert, puis un autre demande le nom de la feuille.
La plage à transférer est fixe : Range("A2:C100").Copy mais peut-être adaptée.
A essayer avec tes classeurs !
Sub TransfertDonnees()
Dim Classeur As String, Feuille As String
Dim Lig As Integer, MyValue As Byte, i As Integer
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 l'impression
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 <> "Numéro"
' Affiche le message de saisie du nom de la feuille du classeur source
Do
Feuille = InputBox("Veuillez entrer le Nom de la feuille source !", _
"ORIGINE DES DONNEES", "Nom") ' Valeur de la variable.
If Feuille = "Nom" Or Classeur = "" Then
'Message de vérification de décision d'annuler l'impression
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 Feuille <> "" And Feuille <> "Numéro"
' Mise en forme
Classeur = Classeur & ".xls"
'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(Feuille).Range("A2:C100").Copy
ThisWorkbook.Sheets("Kits").Range("A" & Lig + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Cordialement
Bernard