Discussion :

[afrozeen]

Bonjour
je suis nouvelle sur ce forum ainsi qu'en VBA 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 :

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
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.

[aalex_38]

Au lieu de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With ActiveSheet

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With WorkSheets("Nomdemafeuille")

[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

[DeaD78]

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
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

[afrozeen]

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

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
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

merci infiniment pour la reponse

[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 ?

[aalex_38]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[afrozeen]

Merci pour tout, ça marche
à bientot