[RESOLU] VBA Copies de plusieurs cellules en ligne vers autre feuille

[Emmanuel_3005]

Bonjour,

Après plusieurs jours de recherche j'ai décidé de m'inscrire sur ce forum car je ne parviens pas à trouver de solution.
Voilà mon problème : je tente de mettre au point un formulaire pour la confection de Devis et leur enregistrement dans une base de donnée Excel.
Ma première feuille intitulée "Devis" présente le devis tel qu'il est envoyé au client, prêt à être imprimé.
Ma deuxième feuille intitulée "Base" regroupe, en ligne, l'ensemble des informations inscrites dans Devis. En d'autres termes, suite à l'archivage d'un Devis (via une macro) toutes les cellules contenant des données relatives au devis en cours (Numéro du devis, Nom du client, Adresse, Total Prix...) sont copiées en ligne dans la base. Jusque là, pas de problème.
Sachant qu'il nous faut parfois modifier nos devis et les éditer à nouveau, je suis en train de créer une macro qui me permette de faire l'opération en sens inverse, c'est à dire copier les données archivées en ligne dans la feuille "Base" vers la feuille "Devis" pour pouvoir modifier et enregistrer à nouveau le document au format destiné au client.
J'aimerais pouvoir éditer mon devis de la feuille "Base" vers "Devis" en cliquant sur la première cellule de la ligne d'archive correspondant à la donnée "Numéro du devis" (colonne B). Pour cela, j'ai enregistré le module suivant dans la feuille "Base" qui appelle la macro "EditionDevis".

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Then
Call EditionDevis
End If
End Sub

C'est maintenant que je pers pied. Je me suis inspiré de quelques scripts que j'ai trouvé à droite et à gauche mais sans succès. J'aimerais en fait que toutes les cellules de "Base" soient copiées dans les cellules de "Devis" correspondantes. Soit :

Sub EditionDevis()

Cl = Range(Traget.Address).End(xlDown).Row 'départ 1ère ligne d'après ce que j'ai compris

Range("b" & Cl).Select
Range("b" & Cl).Copy
With Sheets("Devis")

.Range("a7") = Range("b" & Cl) 'N°
.Range("b3") = Range("c" & Cl) 'contact
.Range("b4") = Range("d" & Cl) 'entreprise
.Range("b5") = Range("e" & Cl) 'adresse
.Range("a6") = Range("f" & Cl) 'date
.Range("a8") = Range("g" & Cl) 'validité
.Range("a9") = Range("h" & Cl) 'type
.Range("a10") = Range("i" & Cl) 'ref client
.Range("a11") = Range("j" & Cl) 'ref ADNId
.Range("a12") = Range("k" & Cl) 'regle
.Range("a15") = Range("l" & Cl) 'des1
.Range("a16") = Range("m" & Cl) 'des2
.Range("a17") = Range("n" & Cl) 'des3
.Range("a18") = Range("o" & Cl) 'des4
.Range("a19") = Range("p" & Cl) 'des5
.Range("a20") = Range("q" & Cl) 'des6
.Range("b15") = Range("r" & Cl) 'pu1
.Range("b16") = Range("s" & Cl) 'pu2
.Range("b17") = Range("t" & Cl) 'pu3
.Range("b18") = Range("u" & Cl) 'pu4
.Range("b19") = Range("v" & Cl) 'pu5
.Range("b20") = Range("w" & Cl) 'pu6
.Range("c15") = Range("x" & Cl) 'Q1
.Range("c16") = Range("y" & Cl) 'Q2
.Range("c17") = Range("z" & Cl) 'Q3
.Range("c18") = Range("aa" & Cl) 'Q4
.Range("c19") = Range("ab" & Cl) 'Q5
.Range("c20") = Range("ac" & Cl) 'Q6
.Range("d15") = Range("ad" & Cl) 'PT1
.Range("d16") = Range("ae" & Cl) 'PT2
.Range("d17") = Range("af" & Cl) 'PT3
.Range("d18") = Range("ag" & Cl) 'PT4
.Range("d19") = Range("ah" & Cl) 'PT5
.Range("d20") = Range("ai" & Cl) 'PT6
.Range("d22") = Range("aj" & Cl) 'Total HT
.Range("d23") = Range("ak" & Cl) 'TVA
.Range("d24") = Range("al" & Cl) 'TOTAL TTC
.Range("a22") = Range("am" & Cl) 'Ech
.Range("a23") = Range("an" & Cl) 'Markers
.Range("a24") = Range("ao" & Cl) 'Type
.Range("a29") = Range("ap" & Cl) 'commentaire
.Range("a46") = Range("aq" & Cl) 'int1
.Range("a49") = Range("ar" & Cl) 'obj1
.Range("a52") = Range("as" & Cl) 'Mat1
.Range("a55") = Range("at" & Cl) 'Miss1
.Range("a58") = Range("au" & Cl) 'Délais1
.Range("a62") = Range("av" & Cl) 'int2
.Range("a65") = Range("aw" & Cl) 'obj2
.Range("a68") = Range("ax" & Cl) 'mat2
.Range("a71") = Range("ay" & Cl) 'miss2
.Range("a74") = Range("az" & Cl) 'délais2
End With
Application.EnableEvents = True
End Sub

Je ne pense pas qu'il faille grand chose dans l'en-tête pour que ça fonctionne mais je ne parviens pas à trouver la solution seul.
J'espère que vous pourrez m'aider.

Excellente soirée à vous tous,

Emmanuel.

 

[bbb38]

Re : VBA Copies de plusieurs cellules en ligne vers autre feuille

Bonsoir Emmanuel_3005, le forum,
Difficile d’obtenir une aide sans un petit fichier d’exemple. Mais c’est ma semaine de bonté. Aussi, j’ai réalisé un modèle, qui je l’espère, pourra t’aider à résoudre ton problème (le code fonctionne que pour les 3 premières données). Une autre solution peut-être envisagée par tableaux.
Cordialement,
Bernard

 

[Staple1600]

Re : VBA Copies de plusieurs cellules en ligne vers autre feuille

Bonjour à tous


juste pour infos:
C'est Target et pas Traget

Cl = Range(Traget.Address).End(xlDown).Row 'départ 1ère ligne d'après ce que j'ai compris

Mais peut-être n'est-ce qu'une simple erreur de frappe dans la discussion et que tu as bien Target dans ton code VBA dans ton classeur.

 

[Emmanuel_3005]

Re : VBA Copies de plusieurs cellules en ligne vers autre feuille

Bonjour bbb38, Bonjour Staple1600,

Je vous remercie pour vos réponses ! Effectivement, la solution que vous proposez en fichier joint parait intéressante et elle fonctionne, je vous en remercie.
Il y a avait bien écrit Traget dans le code mais ce n'était pas la seule origine de l'erreur.

D'un autre coté, on m'a apporté cette réponse qui reprend le code initial et fonctionne très bien :

Sub EditionDevis()

Cl = ActiveCell.Row 'Ligne dans la feuille Base

With Sheets("Devis")
.Range("a7") = Range("b" & Cl) 'N°
.Range("b3") = Range("c" & Cl) 'contact
.Range("b4") = Range("d" & Cl) 'entreprise

...

.Range("c20") = Range("ac" & Cl) 'Q6
End With
End Sub

J'ai maintenant mon code qui fonctionne très bien et j'en suis ravis !
Je vous remercie à nouveau pour votre aide, c'est d'une efficacité sans pareil !

Bonne journée à vous,

Emmanuel.