Discussion :

[antfo]

bonjour , j'essais de creer un programme me permettant pour chaque ligne de mon tableaux pour laquelle une cellule est differente de la meme cellule de la ligne superieur, de copier et d'inserer cette ligne 8 fois en dessous

ex :

li 1 = 1
li 2= 1
li 3 =2
li4= 2

resultat attendu
li 1 = 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 2= 1
li 3 =2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
li4= 2
voici mon programme mais celui-ci ne marche pas :

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
Private Sub CommandButton1_Click()
Dim i As Integer
For i = [468] To [2] Step -1
If Cells(i, 3) <> (Cells(i - 1, 3)) Then
Rows(i + 1).Select
ElseIf Cells(i, 3) = Cells(i + 1, 3) Then
Rows(i & ":" & i).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(i & ":" & (i + 1)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(i & ":" & (i + 4)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
End If
Next i
End Sub

merci d'avance pour tout aide qui pourrait m'être apportée.

Cordialement

[ucfoutu]

Bonjour,

1) commence par indenter ton code (il me dfonne le tournis, sans cette indentation)
2) soit très précis

est differente de la meme cellule de la ligne superieur, de copier et d'inserer cette ligne 8 fois en dessous

"en dessous" de quoi, très exactement ? de la ligne en cours ? de la ligne au-dessus ? tout en bas de tout ?
3) à quoi te sert ici ce select dont tu ne fais absolument rien :

Code :

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

1
2
3
If Cells(i, 3) <> (Cells(i - 1, 3)) Then
Rows(i + 1).Select
ElseIf .....

4) tu remontesd (c'est bien) du bas vers le haut et compares avec ce qu'il y a au-dessus... bien... mais explique alors ceci :

Code :

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

ElseIf Cells(i, 3) = Cells(i + 1, 3) Then

EDIT :
en fait, si tu me mis avec attention et te poses à toi-même les mêmes questions, tu as déjà l'essentiel (pas tout mais presque) de ta solution

[antfo]

cela peut etre effectivement peut comprehensible

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
Private Sub CommandButton1_Click()
   Dim i As Integer
       For i = [468] To [2] Step -1                        
            If Cells(i, 3) <> (Cells(i - 1, 3)) Then
               Rows(i + 1).Select                         
    'si la cellule (i,D) est differente de la cellule (i-1,D), alors ne rien faire et passer à la ligne précédente    
 
                     ElseIf Cells(i, 3) = Cells(i + 1, 3) Then
                         Rows(i & ":" & i).Select
                             Selection.Copy
                            Selection.Insert Shift:=xlDown
                         Rows(i & ":" & (i + 1)).Select
                              Application.CutCopyMode = False
                              Selection.Copy
                             Selection.Insert Shift:=xlDown
                         Rows(i & ":" & (i + 4)).Select
                              Application.CutCopyMode = False
                              Selection.Copy
                              Selection.Insert Shift:=xlDown
'sinon copier la ligne i et l'inserer juste en dessous de la ligne i en 8 exemplaires
            End If
      Next i
End Sub

[antfo]

ca a l'air de marcher de cette facon
merci beaucoup pour ton aide

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
Private Sub CommandButton1_Click()
Dim i As Integer
For i = [468] To [2] Step -1
If Cells(i, 3) <> Cells(i - 1, 3) Then
Rows(i & ":" & i).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(i & ":" & (i + 1)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
Rows(i & ":" & (i + 4)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.Insert Shift:=xlDown
End If
Next i
End Sub