Discussion :

[malek1913]

Bonsoir,

j'aimerai avoir un conseil pour une macro plutot simple consistant répartir les données d'un tableau (lignes entières) sur d'autres feuilles selon condition de la valeur en D.

Merci

[House MD]

Bonjour,

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
sub test()
 
Dim wbk as workbook, wsht1 as worksheet, wsht2 as worksheet
Dim A as long, B as long
 
set wbk=workbooks.open("C:\MonDossier.xls") 'Par exemple
'ou encore : set wbk=thisworkbook si la macro est dans le classeur en question
set wsht1=wbk.worksheets(1)
set wsht2=wbk.worksheets(2)
 
'Dans la feuille 1
with wsht1
  B=1
  A=1
  'On lit toutes les lignes de 1 jusqu'à la dernière cellule non vide en colonne 1
  do until isempty(.cells(A,1))
     'Si la cellule ligne A colonne D (càd 4) = "Tagada"
     if .cells(A,4)="Tagada" then
       'Alors on copie toute la ligne en feuille 2, ligne B (càd 1 au début)
       .rows(A).copy wsht2.cells(B,1)
       'On incrémente B
       B=B+1
     end if
     'On incrément A quoiqu'il arrive pour lire la ligne suivante de la feuille 1
     A=A+1
  loop
end with
 
end sub

[zebulon2212]

Marrant je l'aurrai coder différament
Je part juste du postulat que tu travaille sur un classeur unique

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
Public Sub test()
dim Feuil1, feuil2 ,feuil3 as string
dim ligneF1, ligneF2, ligneF3 as integer
 
Feuil1 = "Nom Feuille1"
Feuil2 = "Nom Feuille2"
Feuil3 = "Nom Feuille3"
ligneF1 = 1
ligneF2 = 1
ligneF3 = 1
 
Do While ActiveWorkbook.Sheets(Feuil1).range("A" & cstr(ligneF1)).value<>""
    Select Case ActiveWorkbook.Sheets(Feuil1).range("D" & cstr(ligneF1)).value
        case "une valeur de D"
            ActiveWorkbook.Sheets(Feuil1).rows(cstr(ligneF1) & ":" & cstr(ligneF1)).copy
            ActiveWorkbook.Sheets(Feuil2).range("A" & cstr(ligneF2)).select
            Selection.paste
            ligneF2 = ligneF2+1
        case "une autre valeur de D"
            ActiveWorkbook.Sheets(Feuil1).rows(cstr(ligneF1) & ":" & cstr(ligneF1)).copy
            ActiveWorkbook.Sheets(Feuil3).range("A" & cstr(ligneF3)).select
            Selection.paste
            ligneF3 = ligneF3+1
    End Select
    ligneF1 = ligneF1 +1
loop