Regroupement de données spécifiques sur une feuille

Bonjour à tous,

Je suis un petit nouveau.

Je ne sais pas trop comment fonctionne le forum, mais voici mon problème.

J'ai un classeur avec une trentaine de feuille, chaque feuille est une famille de produit différents.

Chaque famille de produit ne comporte pas le même nombre d'article.

Sur chaque feuille , j'ai une colonne : stock - commande - disponible(stock-commande).

Il arrive que la colonne disponible soit en négatif.

Je voudrais regouper tous les négatifs de mon dossier (ensemble des familles de produits) sur une seule feuille

dans ce dossier.

Cela est-il possible ?

Un grand merci à toutes personnes qui pourrait m'aider et aussi aux autres qui ne connaissent peut-être pas la solution, si il y en a une.

Bonjour Papout le forum

ton fichier en retour tu n'oublies pas d'activer les macros

tu ouvres tu cliques regrouper et tu vérifies

a+

papou

Bonsoir et bienvenue,

Attention quand même à l'orthographe !

Sub Regroupe()
Dim Sh As Worksheet, Récap As Worksheet
        Application.ScreenUpdating = False
        Set Récap = Sheets("Récupatulitif négatif") 'attention à l'orthographe du nom onglet
    With Récap
        .Range("a2:d" & .[a65000].End(xlUp).Row).Clear
        .Range("k2") = "=d2<0"              'critère filtre
        For Each Sh In Worksheets
          If Sh.Name <> Récap.Name And Sh.Name <> "demande" Then
            '--- filtre ---
            Sh.Range("a1:d" & Sh.[a65000].End(xlUp).Row) _
            .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            .Range("k1:k2"), Unique:=False
            '--- copie dans récap ---
                On Error Resume Next
            Sh.Range("a2:d" & Sh.[a65000].End(xlUp).Row) _
            .SpecialCells(xlCellTypeVisible).Copy Destination:= _
            .Range("a" & Rows.Count).End(xlUp)(2)
            Sh.ShowAllData
                On Error GoTo 0
          End If
        Next
        .Range("k2").ClearContents
    End With
End Sub

Amicalement

Claude

édit: Salut Papou, le temps d'éditer et je ne t'ai pas vu passer

Un grand merci pour votre aide, c'est excatement ce qu'il me faut, mais comme lors de ma présentation je suis assez nul et je ne sais pas comment mettre votre réponse dans mon dossier car le dossier que j'ai mis en pièce jointe était un exemple et la mise en page ne corespond pas à mon vrai dossier.

Je suis désolé pour le temp que je vous fais perdre, mais que faut-il faire car les solutions que vous m'avez proposé sont les bonnes.

Mille excuses pour l'orthographe, mais j'ai un petit probléme avec mon clavier, changement de position du curseur

aléatoire.

Merci de votre compréhension,

Cordialement.

papout.

re,

envoie la structure réelle du fichier

si trop gros, utilise ce lien

utilise ce lien http://www.cjoint.com

on adaptera la macro

Claude

Bonjour,

Je ne réponds pas en MP,

J'ai quand même regarder ton nouveau fichier

J'ai ajouté une feuille "Récap_négatif" où sont extrait les quantités négatives.

J'ai renommé la feuille "Data" qui comportait un espace au début

Dans la feuille "Accueil",

j'ai déverrouillé les cellules B3:B28 pour utiliser les liens

ainsi que la cellule G6 (liée au bouton "oui/non")

Sub Regroupe()
Dim Sh As Worksheet, Récap As Worksheet
        Application.ScreenUpdating = False
Call UnprotectedSheets 'déprotège les feuilles
        Set Récap = Sheets("Récap_négatif") 'attention à l'orthographe du nom onglet
    With Récap
        .Range("a2:g" & .[a65000].End(xlUp).Row + 1).Clear
        .Range("k2") = "=g2<0"              'critère filtre
        For Each Sh In Worksheets
          If Sh.Name <> Récap.Name And Sh.Name <> "Accueil" And Sh.Name <> "Data" Then
            '--- filtre ---
            Sh.Range("a1:g" & Sh.[a65000].End(xlUp).Row) _
            .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            .Range("k1:k2"), Unique:=False
            '--- copie dans récap ---
                On Error Resume Next
            If Application.Subtotal(3, Sh.Range("a:a")) > 1 Then
                Sh.Range("a2:g" & Sh.[a65000].End(xlUp).Row) _
                .SpecialCells(xlCellTypeVisible).Copy Destination:= _
                .Range("a" & Rows.Count).End(xlUp)(2)
            End If
                Sh.ShowAllData
                On Error GoTo 0
          End If
        Next
        .Range("k2").ClearContents
    End With
Call ProtectedSheets 'protège les feuilles
End Sub

vois si çà te va

Amicalement

Claude

Un tout grand merci à tous .

Vous êtes géniaux, la solution est exactement ce que j'espérais.

Encore merci.

Papout,

re,

Pour que tu puisse revenir à la page "Accueil" en cliquant sur "A1"

remplace cette macro par celle-ci

Sub ProtectedSheets()
Dim i As Integer
    ' Protection automatique de toutes les feuilles d'un classeur
    For i = 1 To Worksheets.Count
        With Sheets(i)
            .Unprotect Password:="tcpf"
            .Range("A1").Locked = False
            .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            .EnableSelection = xlUnlockedCells
            .Protect Password:="tcpf"
        End With
    Next i
End Sub

Bonne journée

Claude

Bonjour Claude le forum

je n'avais pas vu ton Edit du départ du post car je n'était pas revenu sur le forum, j'étais au travail

mais tu as bouclé le post comme dab

a+

papou