Discussion :

[dodo28]

Bonjour le Forum
je voudrais réorganiser un tableau. Étant débutant, j ai essayer de suivre vos précieux conseils. J'ai donc rédigé un algo et mis un exemple explicite en fichier joint.
Pour commencer je voudrais savoir si mon algo est bien pensé et si je pouvais commencé à écrire le code.

Voici l'algo :

Copier l'ensemble du tableau "Feuil1" dans la feuille "ListeModifiée"
Supprimé dans la feuille"ListeModifiée" les colonnes (O:AD)
supprimé dans Feuil1 les colonnes (K:N)

pour chaque ligne du tableau "feuil1" sauf la premiere

Si la RAnge(K) contient un texte
alors creer une nouvel ligne dans "listeModifié" contenant toutes les cellules sauf les cellules (O:Z) de Feuil1
end If

supprimé dans Feuil1 les colonnes (K:N)

pour chaque ligne du tableau "feuil1" sauf la premiere

Si la RAnge(K) contient un texte
alors creer une nouvel ligne dans "listeModifié" contenant toutes les cellules sauf les cellules (O:V) de Feuil1
End if

supprimé dans Feuil1 les colonnes (K:N)

pour chaque ligne du tableau "feuil1" sauf la premiere

Si la RAnge(K) contient un texte
alors creer une nouvel ligne dans "listeModifié" contenant toutes les cellules sauf les cellules (O:R) de Feuil1
End if

supprimé dans Feuil1 les colonnes (K:N)

pour chaque ligne du tableau "feuil1" sauf la premiere

Si la RAnge(K) contient un texte
alors copier une nouvelle ligne dans "listeModifié"
End if

Merci pour votre aide

[dodo28]

bonjour,
j ai réussi la première étape. Ça a l'air de marcher.

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
Sub copierLeTableauDansListeModifié()
'
 
'Copie le tableau de feuil1 vers ListeModifiée
 
 Sheets("Feuil1").Activate: Range("a1:Al" & Range("a65536").End(xlUp).Row).Copy _
 Destination:=Sheets("ListeModifiée").Range("A1")
 
'selection des colonnes O:AD de listeModifiée
Sheets("ListeModifiée").Activate
Columns("O:AD").Select
 
'suppression des colonne O:AD
Selection.Delete Shift:=xlToLeft
 
 
 
End Sub

mais c après je suis un peu perdu (voir complètement).
merci de m orienter

[Fvandermeulen]

Salut,
Bravo pour le début, on peu simplifier mais on ne va pas pinailler.
Voici une piste pour la suite (mais je te laisse bosser...)

Pour balayer les cellules que tu veux contrôler, il faut utiliser une boucle.
Pour connaître la plage, on va utiliser une partie de ton code.
On va affecter à une variable la dernière ligne utilisée sur base de la colonne A:

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 derLigne As Long, Ajout As Long
Dim i As Integer
 
derLigne = sheets("feuil1").Range("A65536").End(xlUp).Row 'Renvoi la dernière ligne remplie de la colonne A
Ajout = derLigne 'Defini la ligne pour le collage, à la suite de la derligne
 
For i = 2 To derLigne 'Boucle de 2 à la dernière ligne, 2 car titre en ligne 1
    If IsNumeric(Cells(i, 11)) = False Then 'Si n'est pas numéric alors; i = numéro de ligne; 11 = colonne K
         Ajout = Ajout + 1 'On incrémente la derLigne de 1 pour ajouter à la suite
         Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=Sheets("ListeModifiée").Cells(Ajout, 1)
     'On copie la ligne i de A (1) à  N (14), i prend la valeur selon la boucle, donc première boucle la Range = "A2:N2"
    End If
Next i
End Sub

Par contre, pour être honnête j'ai pas trop regarder ton algo donc je te laisse adapter...

A+

[dodo28]

merci beaucoup pour ton code mais ca plante a :

Code :

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

Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=Sheets("ListeModifiée").Cells(Ajout, 1)

j ai essayer en changeant comme 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
Sub test()
 
Dim derLigne As Long, Ajout As Long, derligneListeModifiée As Long
Dim i As Integer
derligneListeModifiée = Sheets("ListeModifiée").Range("A65536").End(xlUp).Row
derLigne = Sheets("feuil1").Range("A65536").End(xlUp).Row 'Renvoi la dernière ligne remplie de la colonne A
Ajout = derLigne 'Defini la ligne pour le collage, à la suite de la derligne
 
For i = 2 To derLigne 'Boucle de 2 à la dernière ligne, 2 car titre en ligne 1
    If IsNumeric(Cells(i, 11)) = False Then 'Si n'est pas numéric alors; i = numéro de ligne; 11 = colonne K
         Ajout = Ajout + 1 'On incrémente la derLigne de 1 pour ajouter à la suite
         Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=derligneListeModifiée.Cells(Ajout, 1)
     'On copie la ligne i de A (1) à  N (14), i prend la valeur selon la boucle, donc première boucle la Range = "A2:N2"
    End If
Next i
End Sub

en pensant qu'il fallait coller à la dernière ligne du tableau de la feuille ListeModifiée

Mais ca ne marche pas
merci

[Fvandermeulen]

La syntaxe de :

Code :

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

Destination:=derligneListeModifiée.Cells(Ajout, 1)

n'est pas correcte, ta variable derligneListeModifiée ne renvoi pas un nom de feuille (etjuste une remarque perso le nom de cette variable est trop long, les variables ont aussi un but de faciliter la lecture du code...)

Je reprend mon code exemple avec ta modif à savoir la dernière ligne de la feuille ListeModifiée que j'ai affecté à Ajout, du coup le reste du code ne dois pas changer.

Réessaies et si il y a un message d'erreur, indique lequel.

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 derLigne As Long, Ajout As Long
Dim i As Integer
 
derLigne = sheets("feuil1").Range("A65536").End(xlUp).Row 'Renvoi la dernière ligne remplie de la colonne A
Ajout = Sheets("ListeModifiée").Range("A65536").End(xlUp).Row 'Defini la ligne pour le collage, à la suite de la derligne
 
For i = 2 To derLigne 'Boucle de 2 à la dernière ligne, 2 car titre en ligne 1
    If IsNumeric(Cells(i, 11)) = False Then 'Si n'est pas numéric alors; i = numéro de ligne; 11 = colonne K
         Ajout = Ajout + 1 'On incrémente la derLigne de 1 pour ajouter à la suite
         Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=Sheets("ListeModifiée").Cells(Ajout, 1)
     'On copie la ligne i de A (1) à  N (14), i prend la valeur selon la boucle, donc première boucle la Range = "A2:N2"
    End If
Next i
End Sub

A+

[dodo28]

alors j ai l erreur 1004 "erreur definie par application ou par l objet" sur la ligne

Code :

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

Sheets("Feuil1").Range(Cells(i, 1), Cells(i, 14)).Copy Destination:=Sheets("ListeModifiée").Cells(Ajout, 1)

merci

[Fvandermeulen]

Vérifies bien le nom des feuilles (Feuil1 et ListeModifiée), je viens de tester chez moi (avec sheet1 au lieu de feuil1 car en anglais) et j'ai pas d'erreur.

A+

[dodo28]

voila g trouvé une autre solution mais qui parait bien chargé car la macro devra s adapter a un fichier de plus 2500 lignes. qu'en pense tu?

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
Sub Traitement()
'
'pour la 1er commune
 
i = 2
Do While i < Sheets("Feuil1").Range("K65535").End(xlUp).Row + 1
If IsNumeric(Sheets("Feuil1").Range("K" & i)) = False And IsDate(Sheets("Feuil1").Range("K" & i)) = False Then
j = Sheets("listeModifiée").Range("K65535").End(xlUp).Row + 1
Sheets("Feuil1").Range("A" & i, "N" & i).Copy Sheets("listeModifiée").Range("A" & j)
Sheets("Feuil1").Range("AE" & i, "IV" & i).Copy Sheets("listeModifiée").Range("O" & j)
 
End If
i = i + 1
Loop
Sheets("Feuil1").Columns("K:N").Delete
'
'pour la 2emme commune
 
i = 2
Do While i < Sheets("Feuil1").Range("K65535").End(xlUp).Row + 1
If IsNumeric(Sheets("Feuil1").Range("K" & i)) = False And IsDate(Sheets("Feuil1").Range("K" & i)) = False Then
j = Sheets("listeModifiée").Range("K65535").End(xlUp).Row + 1
Sheets("Feuil1").Range("A" & i, "N" & i).Copy Sheets("listeModifiée").Range("A" & j)
Sheets("Feuil1").Range("AA" & i, "IV" & i).Copy Sheets("listeModifiée").Range("O" & j)
 
End If
i = i + 1
Loop
Sheets("Feuil1").Columns("K:N").Delete
 
'pour la 3eme commune
 
i = 2
Do While i < Sheets("Feuil1").Range("K65535").End(xlUp).Row + 1
If IsNumeric(Sheets("Feuil1").Range("K" & i)) = False And IsDate(Sheets("Feuil1").Range("K" & i)) = False Then
j = Sheets("listeModifiée").Range("K65535").End(xlUp).Row + 1
Sheets("Feuil1").Range("A" & i, "N" & i).Copy Sheets("listeModifiée").Range("A" & j)
Sheets("Feuil1").Range("W" & i, "IV" & i).Copy Sheets("listeModifiée").Range("O" & j)
 
End If
i = i + 1
Loop
Sheets("Feuil1").Columns("K:N").Delete
 
'pour la 4eme commune
i = 2
Do While i < Sheets("Feuil1").Range("K65535").End(xlUp).Row + 1
If IsNumeric(Sheets("Feuil1").Range("K" & i)) = False And IsDate(Sheets("Feuil1").Range("K" & i)) = False Then
j = Sheets("listeModifiée").Range("K65535").End(xlUp).Row + 1
Sheets("Feuil1").Range("A" & i, "N" & i).Copy Sheets("listeModifiée").Range("A" & j)
Sheets("Feuil1").Range("s" & i, "IV" & i).Copy Sheets("listeModifiée").Range("O" & j)
 
End If
i = i + 1
Loop
Sheets("Feuil1").Columns("K:N").Delete
 
'pour la 5eme commune
i = 2
Do While i < Sheets("Feuil1").Range("K65535").End(xlUp).Row + 1
If IsNumeric(Sheets("Feuil1").Range("K" & i)) = False And IsDate(Sheets("Feuil1").Range("K" & i)) = False Then
j = Sheets("listeModifiée").Range("K65535").End(xlUp).Row + 1
Sheets("Feuil1").Range("A" & i, "N" & i).Copy Sheets("listeModifiée").Range("A" & j)
Sheets("Feuil1").Range("O" & i, "IV" & i).Copy Sheets("listeModifiée").Range("O" & j)
 
End If
i = i + 1
Loop
Sheets("Feuil1").Columns("K:N").Delete
 
 
End Sub

[Fvandermeulen]

Re,
A priori on doit pouvoir alléger mais je suis pas certain que la différence de temps soit notable, finalement 2500 lignes c'est peu

Sur un autre post on avait comparé un For To à un For Each et la différence était plus que ridicule...

A+

[dodo28]

alors merci pour ton aide j apprend plein de chose sur ce site