Discussion :

[spico45]

Bonjour à tous,

j'ai un fichier excel avec un nombre x d'onglets, dans chaque onglet j'ai un ligne qui est en bleue. J'aimerais que dans le dernier onglet, je puisse récuperer les noms d'onglet dans la première colonne et les l'informations qui est bleu à coté.

j'espère que j'ai été assez clair dans ma demande

je vous joins le fichier.

Merci

[fring]

Bonjour et bienvenue sur le forum,

Tu peux tester ceci :

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
Sub test()
Dim i As Integer, f As Integer, DerL As Integer, x As Integer
 
DerL = Sheets(Sheets.Count).Range("A65535").End(xlUp).Row + 1
 
For f = 1 To Sheets.Count - 1
    For i = 2 To Sheets(f).Cells(Rows.Count, 1).End(xlUp).Row
        'ATTENTION !!! 2 COULEURS DE REMPLISSAGE DIFFERENTES
        If Sheets(f).Cells(i, 1).Interior.ColorIndex = 8 Or Sheets(f).Cells(i, 1).Interior.ColorIndex = 34 Then
            With Sheets(Sheets.Count)
                .Cells(DerL, 1) = Sheets(f).Name
                For x = 1 To 5
                    .Cells(DerL, x + 1) = Sheets(f).Cells(i, x)
                 Next
            End With
            DerL = DerL + 1
        End If
    Next
Next
End Sub

[spico45]

Merci beaucoup,

par contre est-ce que c'est possible des lors je rajoute un onglet ou que je modifie la ligne que je récupère elle se change automatiquement dans la feuille récap?

Merci pour la réactivité

[fring]

Le plus simple et le plus rapide est de relancer la procédure dans laquelle j'ai ajouté un bout de code pour vider la feuille récap

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
Sub test()
Dim i As Integer, f As Integer, DerL As Integer, x As Integer
 
With Sheets(Sheets.Count)
    DerL = .Range("A65535").End(xlUp).Row + 1
    .Range("A2:A" & DerL).EntireRow.Delete
End With
 
DerL = 2
 
For f = 1 To Sheets.Count - 1
    For i = 2 To Sheets(f).Cells(Rows.Count, 1).End(xlUp).Row
        'ATTENTION !!! 2 COULEURS DE REMPLISSAGE DIFFERENTES
        If Sheets(f).Cells(i, 1).Interior.ColorIndex = 8 Or Sheets(f).Cells(i, 1).Interior.ColorIndex = 34 Then
            With Sheets(Sheets.Count)
                .Cells(DerL, 1) = Sheets(f).Name
                For x = 1 To 5
                    .Cells(DerL, x + 1) = Sheets(f).Cells(i, x)
                 Next
            End With
            DerL = DerL + 1
        End If
    Next
Next
End Sub

[spico45]

Merci c'est nickel.