Ma boucle ne boucle pas

**Sadr'ihel** · 26/12/2016, 16h48

Bonsoir,

C'est un sujet récurant sur le forum pour l'avoir vu et consulter bien des fois ces derniers jours.
Je n'arrive pas à voir ma solution parmi les post concernant cela.

Donc ma problématique est la suivante:

Je n'ai qu'une colonne à filtrer (la I) copier les valeurs dans un autre classeur faire mes bidouilles sur ce nouveau classeur l'enregistrer en le nommant avec le nom de mon criteria1.

J'ai 27 criteria1 dans une liste et mon souci c'est qu'il reste sur la valeur I1, ne passe pas à la suivante.
Je ne crois pas m'être trompé (bien que ça ne fonctionne pas).

Merci beaucoup pour votre aide.

(NB je sais que les lignes 117 à 120 ne sont pas bonnes encore mais je vais chercher)

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
 Dim Cell As Variant
 
    Dim derlig As Long
    derlig = Range("a" & Rows.Count).End(xlUp).Row
 
    For Each Cell In Sheets("ref").Range("I1:I30")
 
    Dim crit As String
    crit = ActiveCell.Value
 
    If crit = "" Then Exit For
 
    Sheets("travail").Select
    ActiveSheet.Range("$A$2:$J$" & derlig).AutoFilter Field:=9, Criteria1:=crit
    cells.Copy
 
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
'insertion de la formule de comptage
 
    Dim derligf As Long
    derligf = Range("a" & Rows.Count).End(xlUp).Row
 
    Range("i1").Select
    ActiveCell.FormulaR1C1 = "nombre"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(R2C8:R100000C8,RC[-1])"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I" & derligf)
    Range("I2:I" & derligf).Select
 
'déplacement de la colonne de comptage
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Nombre"
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("L2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Maintien"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Observation"
 
'suppression des doublons
    Columns("A:L").Select
    ActiveSheet.Range("$A$1:$L$" & derligf).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6 _
        , 7, 8, 9, 10, 11, 12), Header:=xlNo
 
    Columns("H:I").Select
    Selection.Delete Shift:=xlToLeft
 
'mise en forme du tableau
    Range("A1:L1").Select
    Selection.AutoFilter
    Range("A1:L1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    Range("A1:L1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").ColumnWidth = 22.29
    Columns("D:D").ColumnWidth = 25.29
    Columns("H:H").ColumnWidth = 16.86
 
'Enregistrement sous le code de prestation 2 lettres
    ActiveWorkbook.SaveAs Filename:= _
        "chemin " & crit & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
 
    crit = Empty
    derligf = Empty
 
    Next Cell

**halaster08** · 27/12/2016, 09h01

Bonjour,

Code :

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

1
2
3
4
    For Each Cell In Sheets("ref").Range("I1:I30")
 
    Dim crit As String
    crit = ActiveCell.Value

A chaque tour de boucle crit prend la valeur de ta cellule active pas celle du "cell" défini dans ton for.

**Sadr'ihel** · 27/12/2016, 09h25

Bonjour

Merci beaucoup, avec cette petite précision je viens de gagner 2 jours de boulot.

**Menhir** · 27/12/2016, 09h33

Deux trucs dans ton code m'ont fait dresser les cheveux sur la tête.

Un Dim à l'intérieur d'une boucle !!!

Sort ton Dim crit As String de là et place-le en début de code.

Puisque Cell est une référence de cellule, ne la définit pas comme Variant mais comme Range. Ce sera plus propre.

**Sadr'ihel** · 27/12/2016, 09h46

Pas de problème, je change ça merci pour cette remarque.
Il ne faudrait pas que tes cheveux nettoient le plafond

comme je disais dans d'autre post je débute dans le VBA que je trouve très sympa. (j'ai VBA pour les nuls sur mon bureau ^^)
D'ailleurs des codes que j'exploite sur ce fichier vont être exportés sur d'autre projet que j'ai fait.

Merci encore pour vos remarques

**halaster08** · 27/12/2016, 10h03

Quitte a améliorer ton code, tu peux également virer tout les select, car j'imagine que ce sont des reliquats du a l'enregistreur de macro.
En effet:

Code :

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

1
2
3
 
    Range("i1").Select
    ActiveCell.FormulaR1C1 = "nombre"

s'écrit plus simplement

Code :

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

 Range("i1").FormulaR1C1 = "nombre"

Le select n'est qu'une perte de temps.

Ma boucle ne boucle pas

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager