Macro avec pour critère le nom de la feuille

[Maitre_Banjo]

Bonjour à tous,

Nouveau dans le monde des macro, je me lance dans la création de code, qui pour la plupart du temps ne marche pas d’où ma raison ici !

J’ai un fichier excel avec une multitude d’onglet nommé comme ceci :
Recap / Nom1 / Nom1Orga / Nom2 / Nom2Orga / Nom3 / Nom3Orga / …

Dans chaque onglet Nom (de la personne) il y a un tableau utilisant les colonnes A à F. Ce que j’aimerais c’est que ma macro aille chercher tout les tableaux des feuilles « NomX » et les collent dans l’onglet « Récap » les uns à la suite des autres.

J’ai donc fait ça :
Sub Bouton1_Cliquer()
derLigDest = ActiveSheet.Range(« B » & Rows.Count).End(xlUp).Row
If derLigDest > 1 Then Range(« 2: » & derLigDest).Delete
For Each sh In ActiveWorkbook.Worksheets
derLigDest = ActiveSheet.Range(« A » & Rows.Count).End(xlUp).Row + 1
If sh.Name = « Nom1 » Or sh.Name = « Nom2 » Or sh.Name = « Nom3 » Then
derLigSource = sh.Range(« A » & Rows.Count).End(xlUp).Row
sh.Range(« A2:F » & derLigSource).Copy Destination:=ActiveSheet.Range(« A » & derLigDest)
End If
Next sh
End Sub

Globalement ça fonctionne mais le problème c’est que je dois me taper les noms des 600 feuilles concernées…

J’aimerais donc savoir si on peux améliorer la macro en ajoutant un critère : Si dans le nom de la feuille il n’y à pas « Orga » alors la macro s’exécute ?

J’ai chercher sur internet, tenté plusieurs solution mais je n’arrive à rien de bien probant… J’en appel donc à votre aide.

Merci d’avance à tous ceux qui prendrons le temps de me lire !

[Mimimathy]

Bonjour

[Maitre_Banjo]

En PJ un fichier anonymisé
TEST.xlsm (63,8 Ko)

J’ai laissé 7 feuilles. Les feuilles ne commence pas toutes par un numéro. Le seul critère commun c’est « Orga » qui apparait obligatoirement une feuille sur deux

[Mimimathy]

Re,
Teste avec cette macro,
Comme tous les onglets à récupérer ont en commun en cellule A1 le mot « Salarié »
il faut se pencher sur cette option

Sub Bouton1_Cliquer()
  Application.ScreenUpdating = False
    derLigDest = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
    If derLigDest > 1 Then Range("2:" & derLigDest).Delete
    For Each sh In ActiveWorkbook.Worksheets
        derLigDest = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
         If sh.Name <> "Region SUD" Then
          If sh.Range("A1").Value = "Salarié" Then
            derLigSource = sh.Range("A" & Rows.Count).End(xlUp).Row
            sh.Range("A2:F" & derLigSource).Copy Destination:=ActiveSheet.Range("A" & derLigDest)
          End If
        End If
    Next sh
End Sub

[Maitre_Banjo]

Bonjour Mimimathy,

Je pensais avoir répondu à ta réponse mais non
mieux vaut tard que jamais !
Du coup merci pour ton retour, ça fonctionne très bien et sans aucun soucis !

Je mets ta réponse en solution !