VBA et la coupe du monde 2010

1 pièce(s) jointe(s)

bonjour,
j'ai developpé un macro dont le but est de faire le classement des équipes par groupe en basent sur les resultats des matchs.
le macro ça marche très bien pour le 1er groupe.
comment je peux prolonger sa fonctionnalité pour les autres sans le recopier à chaque fois.
si ma question n'est pas claire dites le moi.
vous trouvez le fichier ci-joint.
merci.

Code:

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, c As Range, c1 As Range
Dim deb(8) As Byte, j As Integer, Lig As Byte
 
If Target.Column = 4 Or Target.Column = 6 Then
   Application.ScreenUpdating = False
   For j = 0 To 7
      deb(j) = 7 * j + 3
   Next j
 
   Lig = Target.Row
   For j = 7 To 0 Step -1
      If Lig >= deb(j) Then
         Exit For
      ElseIf Lig = deb(j) - 1 Then
         Exit Sub
      End If
   Next j
 
   j = deb(j)
   Range("L" & j & ":S" & j + 3).Value = 0
   For Each cel In Worksheets(1).Range("C" & j & ":G" & j + 5)
      If cel.Column = 3 And cel.Offset(0, 1) <> "" Then
         Set c = Range("K" & j & ":K" & j + 3).Find(What:=cel, MatchCase:=False)
         If Not c Is Nothing Then
            c.Offset(0, 1).Value = c.Offset(0, 1).Value + 1 'J
            If cel.Offset(0, 1).Value > cel.Offset(0, 3).Value Then
               c.Offset(0, 2).Value = c.Offset(0, 2).Value + 1 'G
            ElseIf cel.Offset(0, 1).Value = cel.Offset(0, 3).Value Then 'N
               c.Offset(0, 3).Value = c.Offset(0, 3).Value + 1
            End If
            c.Offset(0, 4).Value = c.Offset(0, 1) - c.Offset(0, 2) - c.Offset(0, 3) 'P
            c.Offset(0, 6) = (c.Offset(0, 2) * 3) + (c.Offset(0, 3) * 1) 'Pt
            c.Offset(0, 7) = cel.Offset(0, 1) + c.Offset(0, 7) '+
            c.Offset(0, 8) = cel.Offset(0, 3) + c.Offset(0, 8) '-
            c.Offset(0, 5) = c.Offset(0, 7) - c.Offset(0, 8) 'D
         End If
      End If
      If cel.Column = 7 And cel.Offset(0, -1) <> "" Then
         Set c1 = Range("K" & j & ":K" & j + 3).Find(What:=cel, MatchCase:=False)
         If Not c1 Is Nothing Then
            c1.Offset(0, 1).Value = c1.Offset(0, 1).Value + 1
            If cel.Offset(0, -1).Value > cel.Offset(0, -3).Value Then
               c1.Offset(0, 2).Value = c1.Offset(0, 2).Value + 1
            ElseIf cel.Offset(0, -1).Value = cel.Offset(0, -3).Value Then
               c1.Offset(0, 3).Value = c1.Offset(0, 3).Value + 1
            End If
            c1.Offset(0, 4).Value = c1.Offset(0, 1) - c1.Offset(0, 2) - c1.Offset(0, 3)
            c1.Offset(0, 6) = (c1.Offset(0, 2) * 3) + (c1.Offset(0, 3) * 1)
            c1.Offset(0, 7) = cel.Offset(0, -1) + c1.Offset(0, 7)
            c1.Offset(0, 8) = cel.Offset(0, -3) + c1.Offset(0, 8)
            c1.Offset(0, 5) = c1.Offset(0, 7) - c1.Offset(0, 8)
         End If
      End If
   Next cel
   Range("K" & j & ":S" & j + 3).Sort Key1:=Range("Q" & j), _
       Order1:=xlDescending, Key2:=Range("P" & j), Order2:=xlDescending, _
       Key3:=Range("R" & j), Order3:=xlDescending, Header:=xlNo, OrderCustom:=1, _
       MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
       DataOption2:=xlSortNormal
End If
End Sub

SLTMERCATOG ,

ca serait sympas de ta part que tu mette des commentaire en face tes lignes

merci.