grouper des lignes en un seul avec des conditions

Version imprimable

Bonjour
je suis nouvelle sur ce forum ainsi qu'en VBA :D j'ai une petit souci et ça sera trop aimable de votre part si vous pourriez m'aider:
voilà , j'ai fait une macro en vba qui me recherche une valeur dans ma feuille de calcul. En trouvant cette valeur j'aligne la ligne à laquelle elle appartient et toutes les lignes qui suivent jusqu'à ce qu'il retrouve cette valeur de nouveau, là il fait la mème opération pour m'afficher les lignes qui suivent sur une seule ligne et ainsi de suite jusqu'à la fin de ma feuille,
voilà ce que j'ai fais:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub postraitement() Dim ligne As Long, lig As Long With ActiveSheet derlig = .Range("A65536").End(3).Row For ligne = 1 To derlig Step 1 FirstCar = Left(Range("A" & ligne).Value, 1) If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then PMField = Mid(Range("A" & ligne).Value, 17, 8) 'jusq'ici j'ai trouver ma valeur et je l'ai ranger dans PMField mnt il faut 'copier la 1ère ligne 'tant que ligne ++ ne contient pas PMfield, copier 'sinon retourner au début du for et grouper les lignes qui suivent sur une autre ligne End If Next ligne End With End Sub
J'aimerais que mon résultat soit lu sur une autre feuille de mon classeur.
Je vous remercie d'avance.

20/05/2009, 13h42
aalex_38

Au lieu de

Code:

With ActiveSheet

qui représente la feuille active, tu peux faire :

Code:

With WorkSheets("Nomdemafeuille")
20/05/2009, 16h44
afrozeen

Merci pour ramrque je la prendrais en compte, c juste que je me blique dans la partie :

'copier la 1ère ligne
'tant que ligne ++ ne contient pas PMfield, copier
'sinon retourner au début du for et grouper les lignes qui suivent sur une autre ligne
'Mettre le resuiltat sur une deuxième feuille

c-à-d la suite du code , je ne sais vraiment pas comment faire, ça fait des heures que je suis bloquée ladessus
merci d'avance

Bonjour,
Code:

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 Sub postraitement() Dim ligne As Long, ligstart As Long, ligend As Long Dim FirstCar As String ligstart = 0 ligend = 0 With Worksheets("Feuil1") derlig = .Range("A65536").End(xlUp).Row 'C'est comme ça qu'on trouve la dernière ligne non vide ;) For ligne = 1 To derlig Step 1 FirstCar = Left(Range("A" & ligne).Value, 1) If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then PMField = Mid(Range("A" & ligne).Value, 17, 8) ligstart = ligend ligend = ligne If ligstart <> 0 Then Range("A" & ligstart & ":A" & ligend).EntireRow.Copy Worksheets("Feuil2").Range("A" & ligstart).PasteSpecial xlPasteAll End If End If Next ligne End With Application.CutCopyMode = False Worksheets("Feuil1").Activate Range("A1").Activate End Sub
Normalement, c'est ce que tu souhaites. Je viens de tester, cela fonctionne.
Pour ce qui est de l'adaptation, tu dois juste changer le nom de tes feuilles : ma feuille de base s'appelle Feuil1 par défaut et l'autre se nomme Feuil2.

Enfin, pour ce qui est de la copie, cela copie bien ce que tu souhaites soit :la ligne de départ jusqu'à la ligne d'arrivée comprise puis à nouveau l'ancienne ligne d'arrivée qui devient celle de départ jusqu'à la nouvelle ligne d'arrivée etc etc.

Pour le collage, je ne me suis pas cassé la tête, cela copie les lignes sur la 2ème feuille au même endroit où elles étaient au départ. Tu adapteras selon tes goûts.

Je pense que c'est ce que tu souhaites. Tiens-moi au courant. En espérant que tu ne sois plus bloquée, ça fait mal :roll:

Bonjour
Merci infiniment pour l'intérêt et pour la réponse je et suis reconnaissante,
cependant c'est ça le résultat souhaité, la macro que tu as conçu copie colle sans aligner sur une seule ligne. après les heures de blocage j'ai essayé de progresser un peu et j'ai aboutit à ça finalement, et ça marche :D

Code:

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
Sub postraitement()
Dim ligne As Long, lig As Long, ligne_sh1 As Long
Dim chaine As String
ligne_sh1 = 1
With ActiveSheet
derlig = .Range("A65536").End(3).Row
 
For ligne = 1 To derlig Step 1
 
FirstCar = Left(Range("A" & ligne).Value, 1)
 
If FirstCar = "I" Or FirstCar = "M" Or FirstCar = "E" Then
 
'formattage de la ligne
chaine = Mid(Range("A" & ligne).Value, 1, 102)
 
'copier la 1ère ligne
Sheets("test").Cells(ligne_sh1, 1).Value = chaine
 
'récupérer les caractères 17 à 24 PMfield : Left(ligne
PMField = Mid(Range("A" & ligne).Value, 17, 8)
lig = 1
toto = InStr(1, Cells(ligne + lig, 1).Value, PMField)
 
'tant que ligne ++ ne contient pas PMfield (InStr),
While toto = 0
'formattage de la ligne
chaine = Mid(Cells(ligne + lig, 1).Value, 1, 102)
'copier la ligne en concaténant
Sheets("test").Cells(ligne_sh1, 1).Value = Sheets("test").Cells(ligne_sh1, 1).Value & chaine
 
lig = lig + 1
toto = InStr(1, PMField, Cells(ligne + lig, 1).Value)
lig = lig
Wend
 
ligne_sh1 = ligne_sh1 + 1
 
 
 
'sinon retourner au début du for
 
 
'else, ne rien faire
 
End If
Next ligne
End With
End Sub

:D :D
merci infiniment pour la reponse

21/05/2009, 17h32
afrozeen

Bonjour
Je souhaiterai à present copier les caractère de la cellules A de la première feuille dans une cellule B3 d'une 2ème feuille, comment je dois faire ?

Code:

1
2
 
worksheets(NomFeuil2).Range("B3") = worksheets(NomFeuil1).Range("A1")

22/05/2009, 11h07
afrozeen

Merci pour tout, ça marche :D
à bientot