Bonjour,
Je désire faire une macro dont le but est d'aller extraire certaines données d'une feuille pour les mettre dans une autre...mais j'ai vraiment besoin de faire dans la dentelle...
explications :
J'ai un doc de base en feuille 1 que nous appelerons "Export"
Dans cet export j'ai une colonne qui contient des informations cellule par cellule.
On peut dire que j'ai des blocs de ligne, chacun de ces blocs étant délimités par un titre sur fond gris.
Sous le titre sur fond gris, j'ai une cellule sur fond jaune "ACTIFS SUR 2" puis en dessous des cellules remplies de texte dont le nombre peut varier puis une autre cellule sur fond jaune "EXCLUSIFS CHANTEL.FR" puis des cellules de texte puis une dernière celllule sur fond jaune "EXCLUSIFS CHANTEL" avec en-dessous d'autres cellules avec texte...
Enfin de nouveau un titre sur fond gris etc...
Exemple :
TITRE
ACTIF SUR 2
MARQUE 1
MARQUE 2
MARQUE 3
MARQUE 4
MARQUE 5
EXCLUSIFS CHANTEL.FR
MARQUE 6
MARQUE 7
MARQUE 8
MARQUE 9
MARQUE 10
MARQUE 11
EXCLUSIFS CHANTEL
MARQUE 12
MARQUE 13
MARQUE 14
MARQUE 15
MARQUE 16
TITRE 2
ACTIF SUR 2
MARQUE 17
MARQUE 18
MARQUE 19
EXCLUSIFS CHANTEL.FR
MARQUE 20
MARQUE 21
MARQUE 22
MARQUE 23
EXCLUSIFS CHANTEL
MARQUE 24
MARQUE 25
MARQUE 26
Objectif :
Faire apparaître dans une nouvelle feuille toutes les "Marques" "ACTIFS SUR 2" en gardant le "TITRE" de chacunes.
Exemple de résultat :
TITRE
MARQUE 1
MARQUE 2
MARQUE 3
MARQUE 4
MARQUE 5
TITRE 2
MARQUE 17
MARQUE 18
MARQUE 19
Voici le programme VBA que j'ai commencé à écrire :
Avec ce programme j'arrive à extraire sur une autre feuille uniquement ce résultat :
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 Dim I As Integer 'Numéro de ligne sur Export Dim J As Integer 'Numéro de ligne sur Actifs2 'je supprime la feuille Actifs2 si elle existe déjà If Sheets(2).Name = "Actifs2" Then Sheets(2).Delete 'Inéserer une feuille en 2ème position Sheets.Add after:=Sheets(1) ActiveSheet.Name = "Actifs2" 'Trouvons la ligne de Actifs sur 2 : méthode Find I = Sheets("Export").Range("B4:B37").Find("ACTIF SUR 2").Row + 1 'Copier Coller le titre en gris Sheets("Export").Range("B4").Copy _ Destination:=Sheets("Actifs2").Range("B1") 'Boucle pour faire du = ' J = 2 Do Until Sheets("Export").Cells(I, 2) = "EXCLUSIFS CHANTEL.FR" Sheets("Actifs2").Cells(J, 2) = Sheets("Export").Cells(I, 2) I = I + 1 'incrémenter i J = J + 1 'incrémenter j Loop
TITRE
MARQUE 1
MARQUE 2
MARQUE 3
MARQUE 4
MARQUE 5
Auriez-vous une idée pour que je puisse faire en sorte que ce programme s'applique à toute la colonne et ne s'arrete pas uniquement au premier bloc de ligne ??
Quelques idées que j'avais :
le tableau pouvant varier de taille, je comptais utliser un CurrentRegion au lieu de mon Range("B4:B37")
et je comptais peut-être utliser le fait que mes titres soient sur fond gris pour pouvoir les identifier plus facilement...
Enfin, j'ai cette idée mais je ne sais pas le faire
d'où mon HELPPPPPPP à vous, gentils développeurs
Merci d'avance à ceux qui voudront bien m'aider!!
Partager