Discussion :

[explosion]

bonjour,

j'ai fait un peu de VBA en cours mais c'était il y a très longtemps et la je bloque.

j'aurais besoin de faire une copie de ligne sous condition.

je m'explique

j'ai une liste de nom en colonne A1 10 noms

en colonne C , D , E , F , j'ai des couleurs

le but est que

- si le mouton est de couleur violet , je voudrais copier la ligne complète dans une feuille nommée violet
- si le cheval est de couleur noir , je voudrais copier la ligne complète dans une feuille nommée noir

je connais la fonction copier OK
mais j'ai du mal a mixer la condition avec la copier.

merci de vos conseils

[Neutthsch]

Salut,

Si j'ai bien compris l'idée, voilà qui devrait répondre à ton besoin. A adapter à ce que tu veux bien sur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Couleur()
 
For a = 1 To 6 'boucle sur tes lignes de a à (remplacer x par la dernière ligne)
    For b = 3 To 6 'boucle sur les colonnes qui contiennent les couleurs (c,d,e et f)
        For Each Feuille In ActiveWorkbook.Sheets
            If Feuille.Name = ActiveSheet.Cells(a, b) Then
                DerniereLigne = Feuille.Range("A" & Rows.Count).End(xlUp).Row
                For i = 1 To 6 ' i representant les cellules que tu veux copier
                    Feuille.Cells(DerniereLigne + 1, i) = ActiveSheet.Cells(a, i)
                Next
            End If
        Next
    Next
Next
 
 
End Sub

[explosion]

je vais recommencer car je me suis mal exprimé et je m'en excuse.

j'ai mis en pièce jointe un exemple.

je souhaite mettre une liste de prénom dans la colonne A.

et j'aimerais copier la ligne A3 michel -pierre dans une nouvelle feuil michel.

pareil pour la ligne A4 andre -pierre dans la feuille andre

jusqu'a la ligne A6 maxime dans la feuille autres

[vinc_bilb]

je souhaite mettre une liste de prénom dans la colonne A.
et j'aimerais copier la ligne A3 michel -pierre dans une nouvelle feuil michel.
pareil pour la ligne A4 andre -pierre dans la feuille andre
jusqu'a la ligne A6 maxime dans la feuille autres

Bonjour, ça serait sympa (suggestion) que vous relisiez votre demande.... en tout cas, elle ne me parait pas claire
Vous voulez copier la ligne ou la cellule Axx
Où dans la feuille destination? 1ère ligne? Quid des éventuels éléments déjà présents?

Exemple de code, à adapter certainement (testé):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Test_Copie()
 
Dim WshN As String
Dim InpRng As Range, Cl As Range
Dim ClContAR As Variant
 
    Set InpRng = ThisWorkbook.Worksheets("Adresse mails").Range("A2").CurrentRegion
    Debug.Print InpRng.AddressLocal
 
    For Each Cl In InpRng.Columns(1).Cells
 
        If Not (IsEmpty(Cl)) Then
 
            ClContAR = Split(Cl.Value, " - ", , vbTextCompare)  ' On Split la valeur sur le séparateur " - "
 
            If UBound(ClContAR, 1) <> LBound(ClContAR, 1) Then      'On vérifie que le split a fonctionné = au moins deux éléments
                WshN = LCase(ClContAR(LBound(ClContAR, 1)))
 
                On Error Resume Next
                If IsObject(Worksheets(WshN)) = False Then          ' Si la feuille n'existe pas, on la crée
 
                    ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = WshN
 
                End If
 
                Debug.Print Cl.Row; InpRng.Rows(Cl.Row).Address
                InpRng.Rows(Cl.Row).EntireRow.Copy Destination:=Worksheets(WshN).Range("A1")
 
            End If
 
        End If
 
    Next Cl
 
End Sub

[explosion]

j'ai trouvé une solution pour vous expliquer

une tableau avant
un tableau après

[vinc_bilb]

Bonjour,

Vous pouvez essayer qquechose comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Test_Copie()
 
Dim WshN As String
Dim InpRng As Range, Cl As Range
Dim ClContAR As Variant
 
    Set InpRng = ThisWorkbook.Worksheets("Adresse mails").Range("A2").CurrentRegion
    Debug.Print InpRng.AddressLocal
 
    For Each Cl In InpRng.Columns(1).Cells
 
        If Not (IsEmpty(Cl)) Then
 
            ClContAR = Split(Cl.Value, " - ", , vbTextCompare)  ' On Split la valeur sur le séparateur " - "
 
            If UBound(ClContAR, 1) <> LBound(ClContAR, 1) Then      'On vérifie que le split a fonctionné
                WshN = LCase(ClContAR(LBound(ClContAR, 1)))
 
                On Error Resume Next
                If IsObject(Worksheets(WshN)) = False Then          ' Si la feuille n'existe pas, utilise 'Autres'
 
                     WshN = "Autres"
 
                End If
 
                Cl.Copy Destination:=Worksheets(WshN).Range("A1")
 
            End If
 
        End If
 
    Next Cl
 
End Sub

[Neutthsch]

Bon ben c'est bien le code que je t'ai envoyé, j'avais bien compris, il est à coller dans le module de la page adresse mail, tu l'as essayé?