Discussion :

[kikim78]

Bonjour Forum

Je n'arrive pas à localiser l'erreur sur la macro suivante:


Pourquoi les lettres autres que P, T, M, O sont prisent en considération
Crdt

[Pierre Fauconnier]

Bonjour

C'est plus productif de placer le code de la macro sur le forum, plutôt que de placer ton fichier en pièce jointe.

Il faudrait détailler ce que tu souhaites réaliser. Voici ta macro:

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 copie()
Dim plage As Range, cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cel In plage
Select Case cel.value
Case Is = "T": course = "Trot"
Case Is = "O": course = "Obstacle"
Case Is = "P": course = "Plat"
Case Is = "M": course = "Monte"
End Select
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg)
Next
Sheets("Courses").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents
End Sub

Je suppose que tu souhaites que

Code :

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

1
2
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg)

ne soit réalisé que pour les lettres T, O, P, M

Dès lors, si c'est cela, tu peux utiliser ceci

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
Sub copie()
Dim plage As Range, cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cel In plage
Select Case cel
    Case "T": course = "Trot"
    Case "O": course = "Obstacle"
    Case "P": course = "Plat"
    Case "M": course = "Monte"
    Case Else: course = ""
End Select
if course<>"" then
    dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
    Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy
    Worksheets(course).Range("A" & dlg)
end if
Next
Sheets("Courses").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents
End Sub

Tu peux aussi te passer de is = dans le case, ce n'est pas nécessaire.

Note que je n'ai pas vu la déclaration de Course. Si tu travailles sans la déclaration explicite de tes variables, tu devras affronter pas mal de problèmes de débogage un jour ou l'autre.

[kikim78]

Re
Merci Pierre Fauconnier, mais ya un probleme,
quand je clique sur sauver c'est la premiere ligne qui est simplement selectionnée! est un message d'erreur s'affiche:

Erreur d'execution '438'
Proprieté ou methode non gérée par cet objet

Voir la ligne soulignée qui est en jaune en debogage:

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
Sub copie()
Dim plage As Range, cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cel In plage
Select Case cel
    Case "T": course = "Trot"
    Case "O": course = "Obstacle"
    Case "P": course = "Plat"
    Case "M": course = "Monte"
    Case Else: course = ""
End Select
If course <> "" Then
    dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
    Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy
    Worksheets(course).Range ("A" & dlg)
End If
Next
Sheets("Course").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents
End Sub

J'ai changé le nom de la feuille courses vers course
Crdt

[Pierre Fauconnier]

Désolé. Il y a un _ qui s'est perdu en route.

Les bonnes lignes sont

Code :

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

1
2
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy _
Worksheets(Course).Range ("A" & dlg)

[kikim78]

Re

Merci Pierre

C'est réglé le probleme, sauf que!
Si je voulais que les lignes autres que PTMO ne disparaissent pas mais restent dans la feuille course?

Possible?

[Pierre Fauconnier]

Tu as une ligne avec ClearContents en dehors de la boucle. Il faudrait la placer à l'intérieur de For... Next, juste avant le Next et l'adapter pour qu'elle ne nettoie que les lignes qui contiennent T,O, P ou M...

Attention que ClearContents vide les lignes, mais ne les supprime pas...

[kikim78]

Re forum

Merci beaucoup pour ton aide, quoi que je suis faible en prog macro, et je doute pouvoir realiser cette derniere etape.

Crdt

[Pierre Fauconnier]

Réponds déjà à la question:

Veux-tu vider les lignes ou veux-tu les supprimer?

[kikim78]

Re
Les lignes vides je les suprime definitivement,
les lignes qui reste je les garde "autre que P,T,M,O"
Crdt,

[Pierre Fauconnier]

Il suffit alors de supprimer les lignes qui sont copiées

Code :

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

1
2
3
4
5
6
If course <> "" Then
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy _
Worksheets(course).Range ("A" & dlg)
cell.entirerow.delete
End If

Mais tu dois alors commencer par le bas de ton tableau et modifier un peu ta boucle, puisque tu supprimes des lignes.

Code :

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

1
2
3
4
5
6
7
dim DerniereLigne as long, i as long
 
Ligne = Range("C65536").End(xlUp).Row
for i = derniereligne to 2 step -1
    ...
    ...
next i

[kikim78]

Re

Merci beaucoup pierre,
Pardon ya encors une erreur !

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
Sub copie()
Dim plage As Range, cel As Range
Dim dlg As Integer
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cel In plage
Select Case cel
Case "T": course = "Trot"
Case "O": course = "Obstacle"
Case "P": course = "Plat"
Case "M": course = "Monte"
Case Else: course = ""
End Select
If course <> "" Then
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1
Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy _
Worksheets(course).Range("A" & dlg)
Cells.EntireRow.Delete
End If
Next
Sheets("Course").Range("A2:G" & Range("A65536").End(xlUp).Row).ClearContents
Dim DerniereLigne As Long, i As Long
 
Ligne = Range("C65536").End(xlUp).Row
For i = DerniereLigne To 2 Step -1
    ...
    ...
Next i
End Sub

Crdt

[kikim78]

Bonjour,

Je crois qu'il me faut dabord apprendre c'est quoi une boucle pour reparer la macro!

Crdt

[kikim78]

Bonjour Forum,
Je revien pour presenter la solutation adequate :

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
Sub copie() 
Dim plage As Range, cel As Range 
Dim dlg As Integer, course 
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row) 
 
For Each cel In plage 
    Select Case cel 
        Case Is = "T": course = "Trot" 
        Case Is = "O": course = "Obstacle" 
        Case Is = "P": course = "Plat" 
        Case Is = "M": course = "Monte" 
    End Select 
        If course <> 0 Then 
            dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1 
            Range(Cells(cel.Row, 1), Cells(cel.Row, 7)).Copy Worksheets(course).Range("A" & dlg) 
            cel.EntireRow.ClearContents 
        End If 
    course = 0 
Next 
End Sub

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
Sub copie() 
Dim i As Integer, lg As Integer, dlg As Integer 
Dim Ok As Boolean 
lig = Range("C65536").End(xlUp).Row 
For i = lig To 2 Step -1 
Ok = 1 
Select Case Range("C" & i) 
Case Is = "T": course = "Trot" 
Case Is = "O": course = "Obstacle" 
Case Is = "P": course = "Plat" 
Case Is = "M": course = "Monte" 
Case Else: Ok = 0 
End Select 
If Ok <> 0 Then 
dlg = Worksheets(course).Range("A65536").End(xlUp).Row + 1 
Range(Cells(i, 1), Cells(i, 7)).Copy Worksheets(course).Range("A" & dlg) 
Range(Cells(i, 1), Cells(i, 7)).Delete Shift:=xlUp 
End If 
Next 
End Sub

Crdt