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 !