Nouvelle feuille selon condition de cellule

[Nico]

Salut !

J'arrive pas à comprendre pourquoi ma macro ne fonctionne pas...

Pour chaque cellule de la feuille 'données' ayant la couleur=37 alors, il faut créer une nouvelle feuille portant comme nom le contenu de la cellule de couleur.

J'ai tenté ça mais sans succès... pourquoi ?
Si qqn à la solution... Merci d'avance.

Sub CreaFeuilles()

Dim vCel As Object
Dim couleur As Integer
Dim NomFeuille As String


couleur = 0

For Each vCel In Sheets('données').Range('B2:B100')
With vCel.Interior.ColorIndex = 37
If vCel.Interior.ColorIndex = 37 Then
couleur = 1

If couleur = 1 Then

vCel.Value = NomFeuille

ActiveWorkbook.Sheets.Add
ActiveSheet.Name = NomFeuille

End If
End If
End With
Next
End Sub

 

[Law]

Bonjour Nico, le forum,

Un essai ci-dessous :

Sub CreaFeuilles()

Dim vCel As Object
Dim couleur As Integer
Dim NomFeuille As String

couleur = 0

For Each vCel In Sheets('données').Range('B2:B100')
    With vCel.Interior.ColorIndex = 37
        If vCel.Interior.ColorIndex = 37 Then
            couleur = 1
                If couleur = 1 Then
                    NomFeuille = vCel.Value
                    ActiveWorkbook.Sheets.Add
                    ActiveSheet.Name = NomFeuille
                End If
        End If
    End With
Next

End Sub

C'est quasiment le même code que toi, mis à part ton vCel.Value = NomFeuille que j'ai inversé : NomFeuille = vCel.Value. C'est plus logique dans ce sens... 😉

Ciao ciao !! 😉

 

[Blunet]

Salut Nico, de façon plus courte:

Sub CreaFeuilles2()
Dim NomFeuille As String
For Each c In Worksheets('données').Range('B2:B100')
If c.Interior.ColorIndex = 37 Then
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = c.Value
End If
Next
End Sub

Ici le With... End With n'est pas nécessaire et d'autres choses encore, comme la couleur. Pour quoi faire un 2ème test sur la couleur si l'index de couleur=37 ?

 

[Law]

Oups, désolé, pas terrible le code là...

Comme ça c'est mieux :


Sub CreaFeuilles()

Dim vCel As Object
Dim couleur As Integer
Dim NomFeuille As String

couleur = 0

For Each vCel In Sheets('données').Range('B2:B100')
With vCel.Interior.ColorIndex = 37
If vCel.Interior.ColorIndex = 37 Then
couleur = 1

If couleur = 1 Then

NomFeuille = vCel.Value
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = NomFeuille

End If
End If
End With
Next
End Sub

Ciao ciao !! 😉

 

[Blunet]

Salut Law,

Law écrit:

With vCel.Interior.ColorIndex = 37
If vCel.Interior.ColorIndex = 37 Then
couleur = 1
If couleur = 1 Then
NomFeuille = vCel.Value
ActiveWorkbook.Sheets.Add
ActiveSheet.Name = NomFeuille
End If
End If
End With

Le code s'applique donc unniquement aux cellules d'index de couluer 37, pourquoi faire un autre test de l'index de couleur ?

 

[Nico]

Merci les gens !!!

Le code s'applique donc unniquement aux cellules d'index de couluer 37, pourquoi faire un autre test de l'index de couleur ?

Parce que pourquoi faire simple quand on peut faire plus compliqué ?

😉

Merci pour tout.

 

[Nico]

Au fait ?

Les feuilles, ça peut se trier automatiquement dans un ordre croissant par exemple ?

🙂

 

[excalibur]

bonjour tous le monde macro a adapter Option Explicit
Sub TriFeuilles()
Dim Bcle%, Index%, Sh As Object
On Error Resume Next
With ThisWorkbook
For Each Sh In ThisWorkbook.Sheets
For Index = 1 To .Sheets.Count
If LCase(Sh.Name) > LCase(.Sheets(Index).Name) And Sh.Index < Index Then
Sh.Move , .Sheets(Index)
End If
Next Index
Next Sh
End With
End Sub'salutations

 

[excalibur]

bonjour tous le monde macro a adapter Option Explicit
Sub TriFeuilles()
Dim Bcle%, Index%, Sh As Object
On Error Resume Next
With ThisWorkbook
For Each Sh In ThisWorkbook.Sheets
For Index = 1 To .Sheets.Count
If LCase(Sh.Name) > LCase(.Sheets(Index).Name) And Sh.Index < Index Then
Sh.Move , .Sheets(Index)
End If
Next Index
Next Sh
End With
End Sub'salutations