Autres Regrouper

[chilo27]

Bonjour LE FORUM

Je viens vers vous pour simplefier ce que je souhaite si possible obtenir

Mon soucis est de regrouper les dernières lignes de chaque feuille du classeur dans une feuille appelée regroupement en vba
En créent une macro je parviens mais c'est long
Serait il donc possible de simplifier la macro
pour prendre en compte quelque soit le nombre de feuilles dans le classeur
et éventuellement sans tenir des noms des feuilles
Pour que se soit opérationnelle sur n'importe quel classeur
Par avance de vous remercie

 

[patricktoulon]

Bonjour

Sub Regroupement2()
    For Each sh In Worksheets
        ligne = Application.Max(Sheets("REGROUPEMENT").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, 6)
        If sh.Name <> "REGROUPEMENT" Then
            sh.Cells(sh.Rows.Count, 1).End(xlUp).Resize(, 10).Copy Sheets("REGROUPEMENT").Cells(ligne, 1)
        End If
    Next
End Sub

 

[chilo27]

Rebonjour

Merci patricktoulon pour la réponse
Cela fonctionne à merveille, toutefois, je me suis aperçu que toutes les feuilles du classeur sont pris en compte
Dans ce classeur j'ai une feuille nommée Bd et Archive que je ne souhaite pas traité

 

[patricktoulon]

Sub Regroupement2()

For Each sh In Worksheets
ligne = Application.Max(Sheets("REGROUPEMENT").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, 6)
If instr(1; " REGROUPEMENT  toto titi "," "& sh.name &" ")=0 Then
sh.Cells(sh.Rows.Count, 1).End(xlUp).Resize(, 10).Copy Sheets("REGROUPEMENT").Cells(ligne, 1)
End If
Next
End Sub

entre les parenthèses tu met tout les noms que tu ne veux pas séparés par un espace
espace nom1 espace nom2 espace
et terminé c'est réglé

 

[chilo27]

Re
De nouveau merci

mais cette elle n'apprécie pas 1;
La ligne s'affiche en rouge

 

[patricktoulon]

re
erreur loufoque et incompréhensible
ma conclusion première :
tu a certainement une librairie manquante qui te provoque des erreurs insensées

outils/référence/décocher les référence manquantes

après peut être qu'un fichier exemple anonymisé serait de mise afin que l'on puisse voir ce qui ne vas pas
chez moi j'ai testé le fichier du post #1 et ça fonctionne

 

[patricktoulon]

autant pour moi
c'est pas ";" mais "," après le "1"

Sub REGROUPEMENT2()
    For Each sh In Worksheets
        ligne = Application.Max(Sheets("REGROUPEMENT").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, 6)
        If InStr(1, " REGROUPEMENT  toto titi ", " " & sh.Name & " ") = 0 Then
            sh.Cells(sh.Rows.Count, 1).End(xlUp).Resize(, 10).Copy Sheets("REGROUPEMENT").Cells(ligne, 1)
        End If
    Next
End Sub

 

[chilo27]

For Each sh In Worksheets
ligne = Application.Max(Sheets("REGROUPEMENT").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row, 6)
If InStr(1, " REGROUPEMENT BD ARCHIVE", " " & sh.Name & " ") = 0 Then
sh.Cells(sh.Rows.Count, 1).End(xlUp).Resize(, 10).Copy Sheets("REGROUPEMENT").Cells(ligne, 1)
End If

cela ne fonctionne pas

 

[patricktoulon]

je n'en vois pas la raison
testons voir avec le fichier que tu a donné en exemple en y ajoutant cette feuille et avec un msgbox témoins

 

[chilo27]

Merci beaucoup pour votre aide