Transférer une plage de cellule vers un autre onglet

Bonjour,

cela faisait une éternité que je n'avais pas écrit du VBA.

Pour mon asso, je cherche à transférer des données d'une plage de celulle vers un autre onglet lorsqu'un champ à une valeur précise

En gros :

1- Dans l'onglet "A contacter", dès que le champ "Statut" (colonne K) passe à "Contacté(e)", je récupère les champs A à I et je les insère à la ligne 4 de l'onglet "Attente RDV"

2- Même chose, si le champ "Statut" passe à "Refus", je fais la même chose avec les mêmes champs mais je les insère à la ligne 4 de l'onglet "Refus"

Mon souci est que je n'arrive pas à sélectionner correctement la cellule A4 nouvellement créée pour y insérer les données.

Ma ligne "Set DEST" est foireuse, mais je n'arrive pas à la corriger comme il faut :s

Je me tourne vers votre expertise

D'avance merci !

Private Sub Worksheet_Change(ByVal Target As Range) Dim OS As Worksheet 'déclare la variable OS (Onglet Source A contacter) Dim OD As Worksheet 'déclare la variable OD (Onglet Destination Attente RDV) Dim OD2 As Worksheet 'déclare la variable OD2 (Onglet Destination Refus) Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) Set OS = Worksheets("A contacter") 'définit l'onglet source OS Set OD = Worksheets("Attente RDV") 'définit l'onglet destination OD Set OD2 = Worksheets("Refus") 'définit l'onglet destination OD2 If Target.Column <> 11 Then Exit Sub 'si le changement a lieu ailleurs qu'en colonne 11 (=K), sort de la procédure If Target.Value = "Contacté(e)" Then 'si la cellule modifiée vaut "Contacté(e)" OD.Rows(4).Insert 'On ajoute une ligne en ligne 4 Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(-1, 0) 'définit la cellule de destination DEST sur la ligne 4, celulle A créée Cells(Target.Row, 1).Copy DEST.Offset(0, 1) 'copie le recruteur Cells(Target.Row, 2).Copy DEST.Offset(0, 2) 'copie la date Cells(Target.Row, 3).Copy DEST.Offset(0, 3) 'copie le nom Cells(Target.Row, 4).Copy DEST.Offset(0, 4) 'copie le prénom Cells(Target.Row, 5).Copy DEST.Offset(0, 5) 'copie le age Cells(Target.Row, 6).Copy DEST.Offset(0, 6) 'copie le ville Cells(Target.Row, 7).Copy DEST.Offset(0, 7) 'copie la formation Cells(Target.Row, 8).Copy DEST.Offset(0, 8) 'copie le téléphone Cells(Target.Row, 9).Copy DEST.Offset(0, 9) 'copie le mail End If 'fin de la condition If Target.Value = "Refus" Then 'si la cellule modifiée vaut "Refus" OD2.Rows(4).Insert Set DEST = OD2.Cells(Application.Rows.Count, "A").End(xlUp).Offset(-1, 0) 'définit la cellule de destination DEST sur la ligne 4, celulle A créée Cells(Target.Row, 1).Copy DEST.Offset(0, 1) 'copie le recruteur Cells(Target.Row, 2).Copy DEST.Offset(0, 2) 'copie la date Cells(Target.Row, 3).Copy DEST.Offset(0, 3) 'copie le nom Cells(Target.Row, 4).Copy DEST.Offset(0, 4) 'copie le prénom Cells(Target.Row, 5).Copy DEST.Offset(0, 5) 'copie le age Cells(Target.Row, 6).Copy DEST.Offset(0, 6) 'copie le ville Cells(Target.Row, 7).Copy DEST.Offset(0, 7) 'copie la formation Cells(Target.Row, 8).Copy DEST.Offset(0, 8) 'copie le téléphone Cells(Target.Row, 9).Copy DEST.Offset(0, 9) 'copie le mail OD2.Rows(5, 9).Copy OD2.Rows(4, 9) 'copie la liste déroulante raison refus OD2.Rows(5, 10).Copy OD2.Rows(4, 10) 'copie la liste déroulante action End If 'fin de la condition End Sub

Bonjour

1. Option "Contactée"

Dans le code remplacez

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(-1, 0) 'définit la cellule de destination DEST sur la ligne 4, celulle A créée
Cells(Target.Row, 1).Copy DEST.Offset(0, 1) 'copie le recruteur
Cells(Target.Row, 2).Copy DEST.Offset(0, 2) 'copie la date
Cells(Target.Row, 3).Copy DEST.Offset(0, 3) 'copie le nom
Cells(Target.Row, 4).Copy DEST.Offset(0, 4) 'copie le prénom
Cells(Target.Row, 5).Copy DEST.Offset(0, 5) 'copie le age
Cells(Target.Row, 6).Copy DEST.Offset(0, 6) 'copie le ville
Cells(Target.Row, 7).Copy DEST.Offset(0, 7) 'copie la formation
Cells(Target.Row, 8).Copy DEST.Offset(0, 8) 'copie le téléphone
Cells(Target.Row, 9).Copy DEST.Offset(0, 9) 'copie le mail

Par

Range("A" & Target.Row & ":I" & Target.Row).Copy OD.Range("A4")

2. Option Refus

Remplacez

Set DEST = OD2.Cells(Application.Rows.Count, "A").End(xlUp).Offset(-1, 0) 'définit la cellule de destination DEST sur la ligne 4, celulle A créée

Cells(Target.Row, 1).Copy DEST.Offset(0, 1) 'copie le recruteur
Cells(Target.Row, 2).Copy DEST.Offset(0, 2) 'copie la date
Cells(Target.Row, 3).Copy DEST.Offset(0, 3) 'copie le nom
Cells(Target.Row, 4).Copy DEST.Offset(0, 4) 'copie le prénom
Cells(Target.Row, 5).Copy DEST.Offset(0, 5) 'copie le age
Cells(Target.Row, 6).Copy DEST.Offset(0, 6) 'copie le ville
Cells(Target.Row, 7).Copy DEST.Offset(0, 7) 'copie la formation
Cells(Target.Row, 8).Copy DEST.Offset(0, 8) 'copie le téléphone
Cells(Target.Row, 9).Copy DEST.Offset(0, 9) 'copie le mail

Par

Range("A" & Target.Row & ":I" & Target.Row).Copy OD2.Range("A4")

3. Recopie

Dans ces deux lignes, VBA renvoie une erreur

OD2.Rows(5, 9).Copy OD2.Rows(4, 9) 'copie la liste déroulante raison refus
OD2.Rows(5, 10).Copy OD2.Rows(4, 10) 'copie la liste déroulante action

Si je comprends ce que vous voulez faire vous devez remplacer ROWS par CELLS

4. Remarque

Dans la copie des données vers l'autre feuille, j'ai remarqué que le colonne A (Nom) conserve la liste déroulante. Si vous voulez ne pas avoir cette liste déroulante, modifiez les 2 codes de copie proposés par ceci :

Range("A" & Target.Row & ":I" & Target.Row).Copy
OD.Range("A4").PasteSpecial Paste:=xlPasteValues

Pour l'option Refus, remplacez OD par OD2 bien entendu

Si ok, merci de cloturer le fil en cliquant sur le v en haut à droite

Cordialement

Merci beaucoup Dan d'avoir pris le temps de te pencher sur ma demande.

Ca marche impeccable !

Puis-je abuser en demandant comment je pourrais supprimer la ligne qui vient d'être copiée ?

Mon but est qu'une fois que la ligne a été copiée, elle soit supprimée de l'onglet "A contacter"

J'ai tenté le code suivant, mais ça ne fait rien :/

Target.EntireRow.Delete

Re

Essayez ceci

Range("A" & Target.Row).entirerow.delete

Cordialement

Un grand merci !

Je passe ça en résolu !