Discussion :

[jerome.cubi]

Bonjour j'ai une question de debutant en VBA...je dois faire une boucle avec des IF et je ne sais pas trop comment faire cela.
En gros si la cellule a la donnée de la variable "NomClient" il incrémente d'une cellule et pareil si la cellule est vide. le problème est si il y a plus que deux cellules vides et pareil si le nom client est le même, c'est pour cela que j'aimerais faire une boucle.

Merci 1000x de votre aide

Code :

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

1
2
3
4
5
6
7
8
 
 
 If ActiveCell.Value = NomClient Then
        SourceStart = SourceStart + 1
    End If
    If Len(ActiveCell.Value) = Empty Then
        SourceStart = SourceStart + 1
    End If

[mercatog]

Exemple de code qui boucle sur la colonne A de la feuille Feuil1 à partir de la ligne Deb jusqu'à la dernière ligne remplie de la colonne A.
Ce code retourne la ligne SourceStart de la première cellule non vide et différente de la valeur de NomClient (ici pour l'exemple est donnée par la constante NomClient: /!\ à adapter à ta variable et à ton fichier)

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 Test()
Const NomClient As String = "Toto"
Dim Deb As Long, LastLig As Long, i As Long, SourceStart As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'dernière cellule remplie de la colonne A
    Deb = 3                                        'on commence la boucle de la ligne 3
    For i = Deb To LastLig
        If .Range("A" & i) <> NomClient And .Range("A" & i) <> "" Then
            SourceStart = i
            Exit For
        End If
    Next i
End With
MsgBox SourceStart
End Sub

[jerome.cubi]

Bonjour mercatog,

Je te remercie pour ta reponse mais je crois que je ne me suis pas très bien exprimé dans ma question et je m'excuse.

je copie et colle des cellules avec des noms client dans une autre feuille mais pas plus d'une fois car il pourrait avoir plusieurs fois les noms clients mais aussi des blancs.

Je te remercie de ton aide.

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
36
37
38
39
 
Sub CopyClient()
 
DestStart = 1
SourceStart = 1
FlagGen = False
Dim NomClient As String
 
Sheets("Sheet1").Select
 
'
While FlagGen = False
 
 
    Range("a" & SourceStart).Select
 
    If Len(ActiveCell.Value) = Empty Then
    SourceStart = SourceStart + 1
    ElseIf (ActiveCell.Value) = NomClient Then
    SourceStart = SourceStart + 1
 
    End If
 
        Range("A" & SourceStart).Select
        Selection.Copy
 
        Sheets("Sheet2").Select
        Range("B" & DestStart).Select
        ActiveSheet.Paste
 
        Sheets("Sheet1").Select
        Range("A" & SourceStart).Select
        NomClient = ActiveCell.Value
        SourceStart = SourceStart + 1
        DestStart = DestStart + 1
 
Wend
 
End Sub

Voici le code complet (avant modification)

[mercatog]

Si j'ai bien compris, tu veux copier les clients sans doublons vers Sheet2

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
Sub Test()
Dim LastLig As Long, i As Long
 
Application.ScreenUpdating = False
With Worksheets("Sheet1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'dernière cellule remplie de la colonne A
    'On boucle de A1 à Axx de Sheet1
    For i = 1 To LastLig
        'Si la cellule Ai n'est pas vide
        If .Range("A" & i) <> "" Then
            'Si Ai n'est pas encore copiée dans Sheet2, On copie Ai:Bi dans la première cellule vide de la colonne A de Sheet2
            If Application.CountIf(Worksheets("Sheet2").Range("A:A"), .Range("A" & i)) = 0 Then .Range("A" & i & ":B" & i).Copy Worksheets("Sheet2").Cells(.Rows.Count, "A").End(xlUp)(2)
        End If
    Next i
End With
End Sub

Sinon, quelle est ta version d'Excel (Car on peut utiliser RemoveDuplicate à partir d'Excel 2007 et sans boucle)

[jerome.cubi]

C'est exact je veux copier les clients sans doublons de la sheet1 à la 2 dans doublons j'utilise la version 2010, je vais essayer le RemoveDuplicate.

Merci beaucoup

[mercatog]

On copie l'ensemble des données vers Sheet2 et on appel Supprimer les doublons (RemoveDuplicates)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Test()
Dim LastLig As Long
 
Application.ScreenUpdating = False
With Worksheets("Sheet1")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'dernière cellule remplie de la colonne A
    'on copie les données vers Sheet2
    .Range("A1:B" & LastLig).Copy Worksheets("Sheet2").Range("A1")
End With
'On supprime les doublons
Worksheets("Sheet2").Range("A1:B" & LastLig).RemoveDuplicates Columns:=1, Header:=xlNo    'xlYes si tu as en ligne 1 des entêtes de colonnes
End Sub