Discussion :

[MARGAR]

Bonjour le forum,

Je suis entrain manuellement de recopier des N° dans une ligne (B25) et j'aimerais si cela est possible de le
faire automatiquement.
Ci-joint un petit fichier d'explication.

Cordialement et merci

margar

[rjamin]

Bonjour,
Une proposition à tester.
On inscrit un nombre en B25 puis click sur le bouton.

On peut vérifier toute les lignes du tableau en une seule opération également
Voir fichier si on ne vérifie qu'une ligne à la fois il suffit de na laissé qu'un n° à la ligne 25 et effacer tous les autres

[keygen08]

Bonjour,

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Target.Address = Range("b25").Address Then
    With Range("b2:r21")
 
    Set c = .Find(Target.Value, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase _
    :=True)
        If Not c Is Nothing Then
        firstAddress = c.Address
        Do
 
'    If c.Interior.ColorIndex = [c5].Interior.ColorIndex Then
'    r = -1
'    Else
'    r = 1
'    End If
 
        Cells(Target.Row, 3 + p) = c.Offset(0, 1).Value
        Cells(Target.Row, 4 + p) = c.Offset(0, 2).Value
 
        Cells(Target.Row, 12 + a) = c.Offset(r, 0).Value
        Cells(Target.Row, 13 + a) = c.Offset(r, 1).Value
        Cells(Target.Row, 14 + a) = c.Offset(r, 2).Value
 
        Set c = .FindNext(c)
        p = p + 2
        a = a + 3
        Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
End If
End Sub

Mais les adversaire de 2 du tour 3 etant placé en dessous, il reste un souci.

[MARGAR]

Bonjour rjamin, keygen08, le forum

@rjamin,
ta 2ème solution me convient parfaitement, MERCI

@keygen08,
merci aussi pour ta réponse

Cordialement

Margar