Discussion :

[jacfld49]

Bonsoir le forum,

je voudrais que l'on m'explique ce code qui me range un resultat dans une feuille finale mais en 2 série et je voudrais le mettre sur une seule série(la série fait 4 colonnes)

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Public Sub RESULT1_F(ByRef ws As Worksheet, ByVal num As Byte)
Dim sht As Worksheet, shtf As Worksheet
Dim LL As Integer, i As Integer, FinPrem As Integer
Dim LigF As Byte, ColF As Byte
Dim tour As Boolean
 
Application.ScreenUpdating = False
NbPoules = num
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = False
 
Set sht = Worksheets.Add
sht.Name = "Temp"
 
UsfDF2.Show
 
With ws
    For i = 1 To num
        .Range(.Cells(6, 5 * i - 4), .Cells(5 + Opt, 5 * i - 1)).Copy sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
        For i = 1 To num
        LL = .Cells(5, 5 * i - 4).End(xlDown).Row
        .Range(.Cells(6 + Opt, 5 * i - 4), .Cells(LL, 5 * i - 1)).Copy sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next i
End With
 
With sht
        FinPrem = .Cells(Rows.Count, 1).End(xlUp).Row
        .Range("A" & Opt * num + 2 & ":D" & FinPrem).Sort Key1:=.Range("D" & Opt * num + 2), Order1:=xlAscending, Header:=xlNo
End With
 
LigF = 6: ColF = 1
tour = True
 
Set shtf = Sheets("Finales")
With shtf
    .Range("A6:D12").Clear 'Contents
    For i = 2 To NbF + 1
        sht.Range("A" & i & ":D" & i).Copy .Cells(LigF, ColF)
        tour = Not tour
        If tour Then
            LigF = LigF + 1
        Else
            ColF = IIf(ColF = 6, 1, 6)
        End If
    Next i
End With
 
Application.DisplayAlerts = False
sht.Delete
Application.DisplayAlerts = False
shtf.Activate
Set sht = Nothing
Set shtf = Nothing
End Sub

merci d'avance
jack

[Gorfael]

Salut jacfld49 et le forum
Àpriori ton code fonctionne, mais pour la version 2003, normalement, ça devrait bloquer : .Copy n'admet pas l'OffSet (enfin, à ma connaissance)

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Public Sub RESULT1_F(ByRef ws As Worksheet, ByVal num As Byte)
'Paramètres transmis : feuille (Ws) et nombre (0 à 255)
Dim sht As Worksheet, shtf As Worksheet
Dim LL As Integer, i As Integer, FinPrem As Integer
Dim LigF As Byte, ColF As Byte
Dim tour As Boolean
 
Application.ScreenUpdating = False
'bloquer le rafraîchissement écran
NbPoules = num
'parmètre transmis dans NbPoule
On Error Resume Next
'en cas d'erreur continuer
Application.DisplayAlerts = False
'supprimer les message d'alerte
Sheets("Temp").Delete
'supprimer l'onglet "TEMP"
Application.DisplayAlerts = False
'supprimer les message d'alerte (sert à rien)
Set sht = Worksheets.Add
'Sht : nouvelle feuille
sht.Name = "Temp"
'la renommer
UsfDF2.Show
'afficher le UserForm"UsfDF2"
With ws
'avec la feuille ws en préfixe
    For i = 1 To num
    'pour i allant de 1 à num
        .Range(.Cells(6, 5 * i - 4), .Cells(5 + Opt, 5 * i - 1)).Copy sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        '.range devient ws.range, etc...
        'copier Plage(A6:D(5+opt)) de ws dans feuille "Temp" dernière cellule non-vide de A décalée d'une ligne
        'Peut pas fonctionner : Copy n'admet pas offset et dans la macro, opt n'est pas défini (toujours à 0 ou variable globale)
        'sinon, on saute de 5 colonnes en 5colonnes
    Next i
    'i suivant
        For i = 1 To num
        'idem
        LL = .Cells(5, 5 * i - 4).End(xlDown).Row
        'll=dernière ligne non vide de la colonne définie par 5×i-4
        .Range(.Cells(6 + Opt, 5 * i - 4), .Cells(LL, 5 * i - 1)).Copy sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        'même remarques que précédente ligne similaire
    Next i
End With
'fin du préfixe
 
With sht
'nouveau préfixe
        FinPrem = .Cells(Rows.Count, 1).End(xlUp).Row
        'FinPrem = dernière ligne non vide de A
        .Range("A" & Opt * num + 2 & ":D" & FinPrem).Sort Key1:=.Range("D" & Opt * num + 2), Order1:=xlAscending, Header:=xlNo
        'Trier la plage Ax:Dy de la feuille Ws (avec x=(opt×Num+2) et y=FinPrem)
End With
 
LigF = 6: ColF = 1
'initialisation de variables
tour = True
'tour = vrai
Set shtf = Sheets("Finales")
'Shtf=Onglet "Finales"
With shtf
'Préfixe Feuille "Finales"
    .Range("A6:D12").Clear 'Contents
    'Effacer les cellule A6 à D12
    For i = 2 To NbF + 1
    'de i=2 à NbF+1 (variable globale ?)
        sht.Range("A" & i & ":D" & i).Copy .Cells(LigF, ColF)
        'copie de Ai:Di sur cellule Ligne LigF, colonne ColF
        tour = Not tour
        'inverser Tour
        If tour Then
        'si Tour=Vrai
            LigF = LigF + 1
            'ligne=ligne+1
        Else 'sinon (Tour=Faux)
            ColF = IIf(ColF = 6, 1, 6)
            'si colonne=6 (F) alors ColF=1, sinon ColF=6
        End If
        'une fois sur 2 on copie en A ligne LigF
        'l'autre en F ligne LigF+1
    Next i
End With
 
Application.DisplayAlerts = False
'idem
sht.Delete
'supprimer la feuille "Temp"
Application.DisplayAlerts = False
shtf.Activate
'activer la feuille "Finales"
Set sht = Nothing
Set shtf = Nothing
'effacer les variables
End Sub

Il y a des parties de la macro qui ne servent à rien Application.ScreenUpdating = False reste à faux, tant qu'on ne la remet pas à vrai (même si la macro est finie).
des parties ne devraient pas fonctionner (à ma connaissance) et il y a des variables qui doivent être initialisées ailleurs (variables comme Opt).
A+
EDIT suite à la remarque de Pierre Fauconnier, je viens de vérifier, et ça fonctionne, alors que j'étais persuadé du contraire.

[Pierre Fauconnier]

Salut.

Copy admet l'offset en 2003.

[jacfld49]

Bonjour le forum,Gorfael, pierre fauconnier,

oui, mon code fonctionne, mais je voulais qu'on me l'explique pour que je puisse essayer de changer l'affichage en feuilles finales.
Donc, je vous remercie pour l'explication, mais je pense que cela ne me donne pas la solution pour changer l'ordre de copy.
merci
jacky

[Pierre Fauconnier]

Personnellement, je n'ai pas compris ton souhait...

[jacfld49]

Re,

J'ai dans une feuille demi finale des resultat en temps .Le code que j'ai mis sur ce fil, me classe dans l'ordre des temps les 2 demi finale et grace à un USF me demande si je veux prendre les 1er de chaque demi finale ou bien les 1er et 2ème ou bien les 1er,2ème et 3ème et ensuite me les classe en feuille finale sur 2 série(ou poule) , ce que je voudrais c'est qu'il me les classe sur une seule série.
merci
jacky