Ajouter une condition à une macro

Bonjour,

Je souhaite que ma macro soit executé si il est écrit "OUI" dans la cellule R4.

Voici le début du VBA avec donc la première ligne" If (R4) = "OUI" Then" qui pose problème:

Sub Macro1()

'

' Macro1 Macro

' If (R4)="OUI" then

Range("B4:R4").Select

Selection.Cut

Sheets("ARCHIVES").Select

ActiveWindow.ScrollColumn = 1

Range("B4").Select

ActiveSheet.Paste

Sheets("SUIVI DES COMANDES").Select

End If

End Sub

Quelqu'un peut m'aider ?

PS: Ci-joint le fichier excel

Merci

Bonjour,

If Range("R4") = "OUI" Then

En espèrant que cela t'aide ...

Bonjour,

Merci pour ta reactivité James mais le problème reste le même car même quand il est écrit "NON" dans "R4" la macro s'applique...

Re,

Tu peux tester la macro suivante ...

Sub Archivage()
 If Feuil1.Range("R4") = "OUI" Then Feuil1.Range("B4:R4").Cut Destination:=Feuil2.Range("B4")
End Sub

En espèrant que cela t'aide ...

Je n'arrive pas à la faire fonctionner.

L'idée c'est de creer un bouton "rafraichir" qui enverrai toutes les ligne possédant "OUI" dans la colonne "R" sur la page "Archive"

Si tu arrive a envoyer la ligne 4 de la page "suivi de commande" sur la ligne 4 de la page "Archive" sans que la ligne 5 ne parte avec, tu auras répondu à ma problématique.

Ci-joint le fichier excel, ça sera surment plus simple si tu vois le tableau.

Merci encore pour ton aide,

Nico

Bonjour,

Ci-joint ton fichier ...

En espèrant que cela t'aide ...

Wouaa,

Merci !

C'est la première fois que je m'essaye à VBA et j'aurais jamais été capable de faire un truc comme ça !

Il me faudrait des cours...

En tout cas merci beaucoup Mr Bond !

Content que la macro corresponde à ton attente ...

Merci beaucoup .... pour tes remerciements ....

Salut James,

Comment vas-tu ?

Je sais pas si tu te souviens de cette macro qui consistait a envoyer le contenu d'une page sur une autre page dans l'optique de créer une archive.

Les lignes souhaitées sont bien envoyés dans l'archive, le problème c'est que certaine des lignes envoyées dans l'archive disparaissent. Ce qui est embétant dans l'optique de créer une archive...

Tu aurais une idée pour que toutes les lignes envoyées s'accumulent dans l'archive via le VBA ?

Ci-joint le fichier excel, (il a un peu évolué)

Bonne soirée !

Nico,

Bonjour Nico,

Bravo pour l'évolution de ton fichier ...

Ci-joint ton fichier avec une macro améliorée et commentée ...

En espèrant que cela t'aide ....

Bonjour Nico21, James

Sub ArchiveNew()
Dim derDat, derArc
Dim cptDat

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    derDat = Cells(Rows.Count, 2).End(xlUp).Row
    If derDat > 3 Then
        For cptDat = derDat To 4 Step -1
            If Cells(cptDat, 18) = "OUI" Then
                derArc = Feuil2.Cells(Rows.Count, 2).End(xlUp).Row + 1
                Feuil1.Range(Cells(cptDat, 2), Cells(cptDat, 19)).Copy Destination:=Feuil2.Cells(derArc, 2)
            End If
        Next
        For cptDat = derDat To 4 Step -1
            If Cells(cptDat, 18) = "OUI" Then
                Feuil1.Rows(cptDat).Delete shift:=xlUp
            End If
        Next
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

J'en étais au même résultat, par contre je fais une copie de la ligne et dans une 2ème boucle je supprime la ligne, parce que bizarrement lors de mes essais la procédure s'arrêtait à la 1ère suppression ?

Bonjour Nico21, James007, NCC 1701,

Une participation avec le code ci-dessous:

Sub ExtractSupOui()

Dim y As Long
Dim i As Long

Application.ScreenUpdating = False

        x = Feuil1.Range("B65536").End(xlUp).Row
        y = Feuil2.Range("B65536").End(xlUp).Row + 1

            For i = 4 To Feuil1.Range("B" & Rows.Count).End(xlUp).Row
                If Cells(i, 18).Value = "OUI" Then
                Feuil1.Range("B" & i & ":S" & i).Copy Destination:=Feuil2.Range("B" & y)
                Feuil1.Range("B" & i & ":S" & i).EntireRow.Delete
                i = i - 1
                End If
                    y = Feuil2.Range("B" & Rows.Count).End(xlUp).Row + 1
            Next

End Sub

Ci-joint ton fichier en retour:

Cordialement.

Merci James !

Tes commentaires m'aident à comprendre la macro !

Cest vraiment super ce que tu fais !

Tu fais quoi dans la vie sans indiscrétions ?

Très bonne journée à toi,

Nico

Nico21 a écrit :

Merci James !

Tes commentaires m'aident à comprendre la macro !

Cest vraiment super ce que tu fais !

Tu fais quoi dans la vie sans indiscrétions ?

Très bonne journée à toi,

Nico

Content que les commentaires te soient utiles ...

L'objectif c'est que tu gagnes en autonomie ... !!!

Merci ... pour tes remerciements ...