Désignation de certains onglets Excel

Bonjour tt le monde!

Je voudrais intégrer dans ma macro une fonction désignant certains onglets et que pour ces onglets la, or ma macro est exécuter pour tous les onglets! For Each sh In ThisWorkbook.Sheets

Merci pour votre intérêt!

Sub iap()
Dim sh As Worksheet
Dim i As Long, j As Long
Dim A As Integer, k As Integer, H As Integer
    k = 1

    Set sh = Worksheets("Idées à présenter")
    sh.Range("A2 : Z1000").Clear
For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Idées à présenter" Then
        With sh
            For i = 1 To .Range("B" & Rows.Count).End(xlUp).Row
                For j = 1 To .cells(1, Columns.Count).End(xlToLeft).Column
                    If .cells(i, j).Interior.ColorIndex = 40 Then

                        .cells(i, j).EntireRow.copy Destination:=Sheets("Idées à présenter").Range("A2 : Z1000 ").Rows(k)
                        k = k + 1
                    End If
                Next j
            Next i
        End With
        End If
    Next
   Worksheets("Idées à présenter").Select
End Sub

Bonjour

A tester

Modifies en fonction du nom des onglets

Sub iap()
Dim sh As Worksheet
Dim i As Long, j As Long
Dim A As Integer, k As Integer, H As Integer
  k = 1

  Set sh = Worksheets("Idées à présenter")
  sh.Range("A2 : Z1000").Clear
  For Each sh In Sheets(Array("Onglet_01", "Onglet_14", "Onglet.."))
    With sh
      For i = 1 To .Range("B" & Rows.Count).End(xlUp).Row
        For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
          If .Cells(i, j).Interior.ColorIndex = 40 Then
            .Cells(i, j).EntireRow.Copy Destination:=Sheets("Idées à présenter").Range("A2 : Z1000 ").Rows(k)
            k = k + 1
          End If
        Next j
      Next i
    End With
  Next
  Worksheets("Idées à présenter").Select
End Sub

Merci Banzai64 =), ca marche parfaitement!

J'ai crée cette macro pour Chercher des cellules de couleur orange (Interior.ColorIndex = 40), au niveau de toute la colonne B et pas ailleurs. Or en exécutant la macro. Elle recopie toutes les cellules de cette couleur au niveau de tout l'onglet et non pas juste ceux sur la colonne B. je n'arrive pas à régler ce probléme. Merci pour votre aide.

 
With sh
      For i = 1 To .Range("B" & Rows.Count).End(xlUp).Row    '
        For j = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column
          If .Cells(i, j).Interior.ColorIndex = 40 Then
            .Cells(i, j).EntireRow.Copy Destination:=Sheets("Idées à présenter").Range("A2 : Z1000 ").Rows(k)
            k = k + 1

Bonjour

Je ne comprends pas trop ce que tu veux faire

Tu veux copier une cellule ou toute la ligne ?

Un fichier ne serait pas du luxe

Tu notes ce que tu as et tu fais un ou plusieurs exemples de résultat

Je voudrais que la macro copie seullement les lignes où il ya une cellule orange sous la colonne B. Ficher exemple IAP ci-joint.

Merci bien!

Bonjour

A tester

Rebonjour!

J'ai exécuté la macro, elle opère de la même manière que l’ancienne!

L'idée est de ne recopier que et seulement les lignes qui comporte une cellule orange au niveau de de la colonne B

Bonjour

Pourtant le résultat ressemble à l'exemple que tu as fourni

M'aurait-on trompé ?

Remplaces la macro actuelle par celle-ci

Option Explicit

Sub iap()
Dim Sh As Worksheet
Dim Lig As Long, Ligne As Long

  Sheets("Idées à présenter").Cells.Clear
  For Each Sh In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
    With Sh
      For Lig = 1 To .Range("B" & Rows.Count).End(xlUp).Row
        If .Range("B" & Lig).Interior.ColorIndex = 40 Then
          Ligne = Ligne + 1
          .Rows(Lig).Copy Destination:=Sheets("Idées à présenter").Range("A" & Ligne)
        End If
      Next Lig
    End With
  Next Sh
  Sheets("Idées à présenter").Select
End Sub

Tu n'auras que les lignes dont la cellule en colonne B est colorisée

Excellent! Merci Banzai64, c'était effectivement une erreur au niveau de la macro!

ca ressemble à ca maintenant:

Sub iap()
Dim Sh As Worksheet
Dim Lig As Long, Ligne As Long

Set Sh = Worksheets("Idées à présenter")
 Sh.Range("A2:Z1000").Clear
  For Each Sh In Sheets(Array("feuil1", "feuil2", "feuil3"))
    With Sh
      For Lig = 1 To .Range("B" & Rows.Count).End(xlUp).Row
        If .Range("B" & Lig).Interior.ColorIndex = 40 Then
          Ligne = Ligne + 1
          .Rows(Lig).Copy Destination:=Sheets("Idées à présenter").Range("A2 : Z1000 ").Rows(Ligne)

        End If
      Next Lig
    End With
  Next Sh
    Worksheets("Idées à présenter").Select

End Sub

Pour le rendre parfait j'ai voulu inserer a chaque fin de ligne, l'onglet d'où elle a était recopié. J'ai taper cette pari code, Mais malheureusement ca ne marche pas comme il faut!

Je mis ci joint le document excel pour visionner l'erreur! Merci bien

Worksheets("Idées à présenter").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "\" & Sh.Name & "/" & vbTab
Sh.Cells(Lig, Ligne + 0) = Sh.Name

Bonjour

A tester

Sub iap()
Dim Sh As Worksheet
Dim Lig As Long, Ligne As Long, Colonne As Integer

  Ligne = 1
  Set Sh = Worksheets("Idées à présenter")
   Sh.Range("A2:Z1000").Clear
    For Each Sh In Sheets(Array("feuil1", "feuil2", "feuil3"))
      With Sh
        For Lig = 1 To .Range("B" & Rows.Count).End(xlUp).Row
          If .Range("B" & Lig).Interior.ColorIndex = 40 Then
            Ligne = Ligne + 1
            .Rows(Lig).Copy Destination:=Sheets("Idées à présenter").Range("A" & Ligne)
            Colonne = Application.Max(3, Worksheets("Idées à présenter").Cells(Ligne, Columns.Count).End(xlToLeft).Column)
           Worksheets("Idées à présenter").Cells(Ligne, Colonne) = "\" & Sh.Name & "/"
          End If
        Next Lig
      End With
    Next Sh
    Worksheets("Idées à présenter").Select

End Sub