Copier une Ligne dans une autre feuille Si

Bonjour à tous,

J'ai une base de données brut et je souhaiterais "trier" automatiquement le contenu dans des feuilles spécifiques. Par exemple, toutes les lignes où l'on trouve le mot "Bleu" j'aimerais qu'elles soient copiés automatiquement dans la feuille "Bleu" et de même pour d'autres couleurs.

Un grand merci pour votre aide

Bonjour,

Sans voir la conception de la BDD et la structure des feuilles pour coller les données, pas facile

Un classeur sans données confidentielles serait souhaitable

Toutes mes excuses. Voici un fichier test. Du coup une ligne où il y a "Rouge" je souhaiterais qu'elle soit copiée automatiquement dans la feuille "rouge" et la même chose pour les autres couleurs.

Merci encore

Bonjour à tous,

A tester...

Option Explicit

Sub test()
'Déclarations des variables
 Dim dl As Long, i As Integer
 Dim plage As Range, cel As Range
 Dim dico As Object, sh As Object
 Dim tp As Variant

Application.ScreenUpdating = False  'désactive le rafraichissement de l'écran

  'Plage de critères
  With Sheets("Données")
    dl = .UsedRange.Rows.Count + 2  'dernière ligne éditée de la feuille Données
    Set plage = .Range("E4:E" & dl) 'plage de critères
  End With

'Utilisation d'un dictionnaire pour stocker les critères sans doublons
Set dico = CreateObject("Scripting.Dictionary")
 For Each cel In plage
    dico(cel.Value) = ""
 Next cel

 'Vérification si les onglets correspondant aux critères existent, sinon on les crée
 tp = dico.keys  'on stocke les critères dans le tableau tp
  For i = 0 To UBound(tp) 'boucle sur chaque éléments du tableau tp
    On Error Resume Next
     Set sh = Sheets(CStr(tp(i))) 'définit le nom de l'onglet en fonction du critère
      If Err <> 0 Then 'si l'onglet n'existe pas, une erreur est générée
        Err = 0 'annule l'erreur
        Sheets.Add after:=Sheets("Données") 'crée l'onglet après la feuille Données
        Set sh = ActiveSheet
        sh.Name = CStr(tp(i)) 'renomme l'onglet crée
      End If

    'Retranscription des données dans les onglets correspondants
    On Error GoTo 0
    sh.Cells.Clear 'efface les données existantes
     With Sheets("Données")
     .Range("B3").AutoFilter
     .Range("B3").AutoFilter Field:=4, Criteria1:=tp(i) 'filtre la colonne E (4ème colonne du tableau de données)
     .Range("B3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy sh.Range("A1") 'copie les lignes filtrées
     .Range("B3").AutoFilter 'retire le filtre
     End With
  Next i
End Sub

Largement inspirée d'une macro de ThauThème que j'avais en stock...merci à lui....

Cordialement,

Bonjour,

Un grand merci pour votre aide c'est top ! J'ai un souci c'est que ma colonne avec les couleurs j'ai une formule qui me permet d'obtenir la couleur du coup toutes mes cellules non rempli dans cette colonne sont en "#N/A". Du coup en copiant les lignes ca me met une erreur et ça me cré une feuille "Erreur2042".

Je ne sais pas si c'est possible mais j'avais imaginé sans bouton avec mes feuilles déjà existantes et dans ma feuille de donnée lorsque une ligne se remplit elle se met automatiquement dans la feuille qui correspond (je remplis une ligne avec "Rouge" et automatiquement la ligne est copié dans la feuille "rouge" déjà existante)

C'est peut-être trop compliqué mais encore merci pour ce travail

Bonjour et merci pour ce retour,

Un essai en rajoutant une condition pour ignorer les cellules vides et en erreur....

'Utilisation d'un dictionnaire pour stocker les critères sans doublons
Set dico = CreateObject("Scripting.Dictionary")
 For Each cel In plage
  If Not IsError(cel) And Not IsEmpty(cel) Then 'si la cellule ne contient pas d'erreur et n'est pas vide
    dico(cel.Value) = ""
  End If
 Next cel

Cordialement,