Transférer plage de données macro

sebgo

XLDnaute Occasionnel
Bonjour le forum

Grâce à votre aide je suis entrain de finaliser une appli pour la gestion de certaines de mes activités quotidiennes. Je vous en remercie. Ma demande de ce soir concerne le transfert (ou la copie) d'une plage de données d un classeur A vers le classeur "application" par macro. J'ai cherché dans les anciens posts sans succès et je viens solliciter un coup de main. Je veux copier la plage de données (à partir de A2) se trouvant sur la feuille1 du classeur "donnees" et les coller à la suite des données de l'onglet Kits du classeur "Appli". En résumé la macro doit pouvoir ouvrir une boîte de dialogue pour le choix du fichier et également le choix de la feuille, copier la plage et les coller à la suite des données se trouvant dans l'onglet "Kits".
Je vous joint les deux fichiers allégés.
Merci et bonne soirée.
A+
 

Pièces jointes

  • Application.zip
    14.4 KB · Affichages: 42
  • Application.zip
    14.4 KB · Affichages: 39
  • Application.zip
    14.4 KB · Affichages: 40

sebgo

XLDnaute Occasionnel
Re : Transférer plage de données macro

Bonsoir Nat54,
En fait étant donné que le nom du fichier ou sont stockés les données varient, l'utilisateur doit pour l'enregistrer sur le disque et le recupérer à la manière Fichier -> Ouvrir. C'est ce que je voulais dire. Suis-je un peu clair? sinon je reste à l'écoute.

PS: je signale que les futurs utilisateurs de l'application ont un niveau proche de epsilon en informatique. Je dois faire avec, en créant une appli qui ne leur demande pas trop d'effort.
Merçi et A+
 

CBernardT

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

sebgo

XLDnaute Occasionnel
Re : Transférer plage de données macro

Bonjour Bernard,

Merci pour le code. Je l'ai adapté et il marche. Je t'en remercie. Mais j'ai juste une petite question qui me vient en tête. Est-ce possible de parcourir toutes les feuilles du classeur en boucle pour rechercher les données sans demander le nom de l'onglet où sont stockées les données ?
Une fois encore merçi pour ta contribution.
Bonne soirée.

Sebgo
 

CBernardT

XLDnaute Barbatruc
Re : Transférer plage de données macro

Re Sebgo,

Une macro à placer toujours dans le fichier "Appli". Un message demande le nom du classeur source, celui-ci est supposé ouvert, puis une boucle passe en revue les feuilles de ce classeur et recherche si la cellule A2 contient une valeur. En cas de valeur, la plage fixe "A2:C100" est copiée dans le fichier cible et la macro est stoppée.

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:C100").Copy
ThisWorkbook.Sheets("Kits").Range("A" & Lig + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
End If
Next Ws
End Sub

Cordialement

Bernard
 

Discussions similaires

Statistiques des forums

Discussions
312 199
Messages
2 086 160
Membres
103 148
dernier inscrit
lulu56