Incrémenter une boucle

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je voudrais regrouper mes lignes en fonction de la modalité de la variable "toto", c'est à dire, regrouper toutes les lignes ayant une modalité différente d'un nombre

Le code ci-dessous n'arrive pas à incrémenter, pouvez vous m'indiquer mon erreur svp?

Le fichier est joint ci-contre également.

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
 
 
 
Sub toto()
 
Dim epinof As Workbook
Dim epinofsheet As Worksheet
 
Workbooks.Open ("C:\Users\s044914\Desktop\EPINOF07.xlsx"), local:=True
Set epinof = Workbooks("EPINOF07.xlsx")
Set epinofsheet = epinof.Worksheets("EPINOF07")
epinofsheet.Activate
Nb = Range("A" & Rows.Count).End(xlUp).Row
 
Cells.Find(What:="toto", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
colonne = ActiveCell.Column
'le nombre de lignes
For i = 2 To Nb
    If Left(Cells(i, colonne), 1) = "*" Then
        Range("A" & i & ":" & "C" & i).Select
        Selection.Copy
        Sheets("toto").Activate
        debut = Range("A" & Rows.Count).End(xlUp).Row + 1
        Range("A" & debut).Select
        'copier coller en valeur
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub toto()
 
Dim epinof As Workbook
Dim epinofsheet As Worksheet
Dim R As Range
Set epinof = Workbooks.Open("C:\Users\s044914\Desktop\EPINOF07.xlsx", local:=True)
Set epinofsheet = epinof.Worksheets("EPINOF07")
Set R = epinofsheet.Range("A1").CurrentRegion
For i = 2 To R.Rows.Count
    If Left(Trim("" & R(i, 3)), 1) = "*" Then
        R.Range(R(i, 1), R(i, R.Columns.Count)).Copy
       epinof.Sheets("toto").Range("A" & epinof.Sheets("toto").Range("A1").CurrentRegion.Rows.Count + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    End If
Next
 
End Sub

20/01/2014, 16h07
idhmida

Merci beaucoup rdurupt!!:ccool::ccool::ccool: