Transfert des données d'une feuille à une autre sous condition

Bonjour tout le monde,

S’il vous plait, j'ai besoin de votre aide pour régler une problématique que je n’arrive pas à résoudre depuis quelques jours. En fait, j’ai une feuille (BD) qui sera alimenter par des informations d’une autre feuille (Accueil). Jusqu’à date tout va bien. Aussi, quand je mets le curseur sur une valeur de la colonne (PPP) et que je clique sur le bouton (Choix des données), j’aurai automatiquement sur la feuille (BD) juste les lignes de la valeur que j’ai choisi par le bouton (Choix des données), puis, je choisi (x) sur la colonne (U) transfert. Par la suite, je clique sur le bouton Archiver et les lignes dans lesquelles j’ai choisi (x) sur la colonne (U) se transfert immédiatement dans l’autre feuille (Archive). Jusqu’à date tout va encore bien.

La problématique, c’est que quand je fais le choix d’un paramètre sur la colonne PPP, par exemple le paramètre (LAL-700), et que je clique sur le bouton Choix des données, et qu’après je choisi (x) sur la colonne (U), puis que je clique sur archiver, je souhaiterai que les ID qui sont sur la colonne (A) et qui sont identiques des ID de LAL-700 seront aussi archiver automatiquement même si ces ID n’ont pas LAL-700 sur la colonne(PPP).

Exemple : ID : RAN000156

Cordialement

Bonjour,

Avec ce code modifié > si la feuille n'est pas filtrée ...

Un essai ...

Sub ARCHIVAGE()

   'On désactive les messages d'alertes d'excel et on désactive le défilement des macros
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   'Je déclare des variables
   Dim CopyRange As Range
   Dim PasteRange As Range
   Dim x As Integer
   Dim LID As String

   ' Mémoriser l'ID de la colonne A
   For x = Worksheets("BD").Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If Worksheets("BD").Range("U" & x).Value = "x" Or Worksheets("BD").Range("U" & x).Value = "X" Then
         LID = Worksheets("BD").Range("A" & x).Value
         Exit For
      End If
   Next x

   'Ici, nous allons travailler du bas du tableau jusqu'en haut car si on fait l'inverse, cela pose problème avec la suppression de ligne
   'Pour x allant de la dernière ligne du tableau à 2
   For x = Worksheets("BD").Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

      'Si la valeur dans la colonne I est "x" ou "X" ou la valeur de LID = la valeur de la colonne A
      If Worksheets("BD").Range("U" & x).Value = "x" Or Worksheets("BD").Range("U" & x).Value = "X" _
         Or Worksheets("BD").Range("A" & x).Value = LID Then

         'On déclare la sélection des celluls à copier ainsi que la sélection des cellules qui vont accueillir les données
         Set CopyRange = ThisWorkbook.Worksheets("BD").Range("A" & Worksheets("BD").Range("S" & x).Row & ":U" & Worksheets("BD").Range("U" & x).Row)
         Set PasteRange = ThisWorkbook.Worksheets("ARCHIVE").Range("A" & Worksheets("ARCHIVE").Range("A" & Rows.Count).End(xlUp).Row + 1 & ":O" & Worksheets("ARCHIVE").Range("A" & Rows.Count).End(xlUp).Row + 1)

         'On copie/colle les données
         PasteRange.Value2 = CopyRange.Value2

         'On supprime la ligne
         Worksheets("BD").Range("U" & x).EntireRow.Delete
      End If
   Next x

   'On active les messages d'alertes d'excel et on active le défilement des macros
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

ric

Bonjour Ric,

Je vous remercier énormément pour votre aide précieuse, ça fonctionne à merveille.

Sincères salutations,