Bonsoir les maîtres du vba
J'ai encore besoin de vos lumières.
Dans un onglet (lotissement), j'ai une liste de données avec des noms qui peuvent changer.
De cette liste, j'aimerai extraire une liste de données par nom en feuille 3.
J'ai créé le programme suivant qui marche en partie (grâce au forum).
Mon probleme est le suivant : quand le nom change de valeur, il me mets des lignes vides (si le nom ne correspond pas à celui en question. Je voudrai supprimer ces lignes vides pour que le nom se mette sur une ligne et les valeurs se placent sur une ligne +1 apres ce nom.(pas de ligne vide inutile)
Je souhaite avoir été clair???
Pouvez vous m'aider?
Cordialement
lps 02
Mon code
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 Option Explicit Sub Test() Creer_Liste_SansDoublons Sheets("lotissement").Range("N12:N3000") End Sub Sub Creer_Liste_SansDoublons(Plage As Range) Dim Cell As Range Dim Un As Collection Dim i As Long, dl As Long, j As Long, b As Long, derlig As Long Set Un = New Collection On Error Resume Next 'Boucle sur la plage de cellule For Each Cell In Plage 'If Cell <> "" Permet de ne pas prendre en compte les cellules vides 'Un.Add Cell, CStr(Cell) Ajoute le contenu de la cellule dans la collection If Cell <> "" Then Un.Add Cell, CStr(Cell) Next Cell On Error GoTo 0 'Boucle sur les éléments de la collection. For i = 1 To Un.Count dl = Sheets("Feuil3").Range("A" & Sheets("Feuil3").Rows.Count).End(xlUp).Row Sheets("Feuil3").Range("A" & dl + 2).Value = Un.Item(i) j = 12 derlig = Sheets("Feuil3").Range("A" & Sheets("Feuil3").Rows.Count).End(xlUp).Row b = derlig + 2 With Sheets("lotissement") While .Range("A" & j) <> "" If .Range("N" & j).Value = Un.Item(i) Then .Range("A" & j & ":M" & j).Copy Destination:=Sheets("Feuil3").Range("A" & b) End If j = j + 1 b = b + 1 Wend End With Next i Set Un = Nothing End Sub
Partager