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
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
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
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager