XL 2016 Déplacer une ligne si elle contient le mot "OUI" dans la colonne T

Jess88026467

XLDnaute Nouveau
Bonjour,

J'ai une feuille source où la colonne T donne la condition de transfert de la ligne vers le fichier de destination.

Une fois la ligne dans le fichier de destination je ne souhaite plus la voir apparaitre dans le fichier source.

Pouvez -vous m'aider ?
J'ai déja essayé plusieurs macro mais il n'y a toujours un problème. Celle qui se rapproche le plus de mes attentes est :
(celle ci transfert si le code reconnait le chiffre 1 dans la ligne, je souhaite juste remplacer "1& par "OUI" et sélectionner la colonne T)

Sub Archivageformation()

Dim I As Long, Plage As Range, Ligne As Long
On Error Resume Next
Ligne = Sheets("Formation (archives)").Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
If Err.Number > 0 Then Ligne = 0
On Error GoTo 0
With Sheets("Formation (personnel)")
For I = 1 To .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
If Application.CountIf(.Rows(I), 1) > 0 Then
Ligne = Ligne + 1
.Rows(I).Copy Sheets("Formation (archives)").Cells(Ligne, 1)
End If

Next I
For I = .Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row To 1 Step -1
If Application.CountIf(Rows(I), 1) > 0 Then
Rows(I).Delete
End If
Next I
End With
End Sub

Merci pour votre aide, je n'ai aucunes bases en VBA et il est compliqué poiur moi d'adapter les codes.
 

Backhandshot

XLDnaute Occasionnel
Bonjour à tous !
Voici le code pour ta demande
La colonne T doit contenir "oui" comme tu as demandé
Vois si cela te convient

Sub Archivageformation()
Dim MotCle
Dim i As Byte
Dim C As Range
Dim F As String
Dim Ligne As Long
'On définit les mots clés
MotCle = Array("oui")
'On effectue la recherche de chaque mot clé dans la colonne F de la sheet1
For i = 0 To UBound(MotCle)
Do
Set C = Worksheets("Formation(personnel)").Columns(20).Find(MotCle(i), LookIn:=xlValues, lookat:=xlPart)
'Si le mot clé est trouvé
If Not C Is Nothing Then
'On définit le nom de la feuille où sera effectuée la copie
F = "Formation(archives)"
With Worksheets(F)
'On définit la ligne où sera effectué le collage
Ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
'On effectue le copier / coller
C.EntireRow.Copy .Range("A" & Ligne)
'On supprime la ligne dans la sheet1
C.EntireRow.Delete
End With
End If
Loop While Not C Is Nothing
Next i
End Sub
 

Jess88026467

XLDnaute Nouveau
Bonjour à vous deux,

BackandShot : je te remercie pour ton code il a très bien fonctionné! Entre temps j'en ai trouvé un second (je vous le partage, si jamais je peux aider à mon tour)

'Macro pour archiver les formations du personnel qui est parti.
Sub Bouton4_Cliquer_Archivage()

A = Worksheets("Formation (personnel)").Cells(Rows.Count, 2).End(xlUp).Row

For i = A To 2 Step -1
If Worksheets("Formation (personnel)").Cells(i, 20).Value = "OUI" Then
Worksheets("Formation (personnel)").Rows(i).Copy Worksheets("Formation (archives)").Cells(Worksheets("Formation (archives)").Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Worksheets("Formation (personnel)").Rows(i).EntireRow.Delete

End If
Next
End Sub

Robert : oui vous avez raison, c'est vrai que je pensais qu'une petite explication suffit mais c'est vrai qu'un fichier est tout de suite plus parlant. J'y ferais attention la prochaine fois que j'aurais besoin d'aide.

Merci encore et bonne journée
 

Phil69970

XLDnaute Barbatruc
Bonjour Jess, le forum

Je te propse ceci :
VB:
Sub Archivageformation()
Application.ScreenUpdating = False
Dim Derlig1&, Derlig2&

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet

Set Sh1 = Sheets("Formation (personnel)")
Set Sh2 = Sheets("Formation (archives)")

Derlig1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
Derlig2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row + 1

For i = Derlig1 To 2 Step -1
    With Sh1
        If .Range("T" & i) = "OUI" Or .Range("T" & i) = "oui" Or .Range("T" & i) = "Oui" Then
            .Range("A" & i & ":T" & i).Copy Sh2.Range("A" & Derlig2)
            .Range("A" & i).EntireRow.Delete
            Derlig2 = Derlig2 + 1
        End If
    End With
Next i

Set Sh1 = Nothing
Set Sh2 = Nothing
End Sub

@Phil69970
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 966
Membres
101 852
dernier inscrit
dthi16088