[XL 2010 UK WIN] : Récap de données dans un onglet

Bonjour,

J'aimerai via du VBA (et non des formules ) récupérer des données de plusieurs onglets dans un seul et même onglet de ce même fichier (c.a.d. tout est dans un unique fichier).

Mon onglet principal qui collecte les informations de tous les autres onglets porte un nom et peu être déplacé d'un endroit à l'autre du fichier excel (le nom de cet onglet est par exemple "Global Card".

Le fichier excel peut contenir tout un tas d'onglet n'importe où qui ont des noms aléatoires, cependant les onglets concernés (ceux à qui nous voulons récupérer des données pour les mettre dans un tableau dans l'onglet "Global Card" répondent à une règle de nommage.

Règle de nommage: Les onglets doivent avoir un nom du genre "Project x" ou x prend la valeur 1, puis 2, puis 3... à chaque fois qu'un projet est rajouté dans le fichier excel (soit un onglet par projet).

Voilà donc si vous pouvez m'aider, juste la copie de la cellule B1 par exemple serait suffisant pour le test, je m'occuperai de faire tout le reste bien sûr

Merci pour vos réponses

Amicalement,

P.

Bonjour

Un essai à tester. Te convient-il ?

Bye !

9classeur1-v1.xlsm (26.53 Ko)

Bonjour gmb,

Oui c'est pas mal j'aime bien.

Cependant j'aimerai plutôt les mettre en ligne comme dans le fichier joint.

Et si possible appliquer un tri à la fin de la génération suivant la case qui a été cochée.

Si pas de case cochée l'option 1 sera retenue.

De plus, chaque onglet projet peut avoir des cellules à récupérer un peu partout dans la feuille (un peu comme un "patchwork") mais chaque onglet de projet son basé sur le même modèle.

Merci à vous encore pour votre aide et explication.

Amicalement,

P.

Nouvelle version.

Bye !

16classeur1-v2.xlsm (44.86 Ko)

Bonjour gmb,

Merci beaucoup pour ton aide

Coté filtre j'ai pu adapter le code que tu m'as fourni et le résultat me plait bien pour l’instant

Mon code grâce à vous:

Option Explicit

Private Sub Title_Click()
    If Title = True Then
'        Range("B:B").Sort key1:=Range("A7"), order1:=xlAscending, Header:=xlYes
    Range("B6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Add Key:=Range( _
        "B7:B1752"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Global card").Sort
        .SetRange Range("B6:G1752")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A6").Select
    End If
End Sub

Private Sub CurrentCost_Click()
    If CurrentCost = True Then
'        Range("B:B").Sort key1:=Range("B7"), order1:=xlAscending, Header:=xlYes
    Range("B6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Add Key:=Range( _
        "E7:E1752"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Global card").Sort
        .SetRange Range("B6:G1752")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A6").Select
    End If
End Sub

Private Sub BlockchainCost_Click()
    If BlockchainCost = True Then
'        Range("C:C").Sort key1:=Range("C7"), order1:=xlAscending, Header:=xlYes
    Range("B6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Add Key:=Range( _
        "D7:D1752"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Global card").Sort
        .SetRange Range("B6:G1752")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A6").Select
    End If
End Sub

Private Sub BusinessValue_Click()
    If BusinessValue = True Then
'        Range("D:D").Sort key1:=Range("D7"), order1:=xlAscending, Header:=xlYes
    Range("B6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Global card").Sort.SortFields.Add Key:=Range( _
        "G7:G1752"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Global card").Sort
        .SetRange Range("B6:G1752")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A6").Select
    End If
End Sub

Par contre pour l'extraction des données c'est un peu plus compliqué.

en fait chaque onglet projet contient plusieurs petits tableaux, donc ce que j'aimerais c'est vraiment pouvoir:

  • 1. extraire cellule par cellule ce dont j'ai besoin
    2. extraire des "ranges" qui sont sur plusieurs lignes (soit 10 ou 20 cellules consécutives par ligne)

Et donc pour chaque projet, j'aurai sur la même ligne (1 par projet) les valeurs de ces cellules et les "ranges" à la suite (sachant que tous les projets ont les mêmes "ranges" aussi qui sont concernés par l’extraction. ok si je ne suis pas clair faut pas hésiter à me le dire

Merci d'avance pour ton aide.

Et merci pour les explications dans ton code c'est vraiment super.

Amicalement,

P.

Bonjour gmb,

aurais-tu une idée?

Désolé je ne sais pas comment m'y prendre.

Amicalement,

P.

Bonjour

Non, je ne vois pas.

Déslolé.

Bye !

Ok merci gmb tu en as déjà beaucoup fait c'était très gentil de ta part

Au plaisir

P.

Hello,

Donc pour ceux qui essayent d'aller plus loin sur mon souci voici un peu le code que je recherche à faire:

Option Explicit

Dim f As Worksheet, derCol&, i&, j&, lgn&

Sub Import()

'    Application.ScreenUpdating = False
    Range("B7").CurrentRegion.Offset(1, 0).ClearContents 'On réinitialise le tableau de départ

    For Each f In Worksheets
        If f.Name Like "Project *" Then     'Boucle qui permet de passer toutes les feuilles qui contiennent
                                            'le mot "Projet " dans le nom de leur onglet

' pour chaque feuille "Projet*" je copie les cellules suivantes et je les colle dans l'onglet "Global card" sur une seule ligne et une ligne par onglet projet

' ici j'imagine qu'il me faut faire une boucle pour aller d'un onglet projet à un autre :

           Je.parcours.le.premier.onglet jusqu'au dernier (if?)
                      f.Name.Range("C1").Select
                           Selection.Copy
                           Sheets("Global card").Select
                           Range(i, j).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False

                         f.Name.Range("AA1001").Select
                           Selection.Copy
                           Sheets("Global card").Select
                           Range(i, j).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False

                       f.Name.Range("G8").Select
                           Selection.Copy
                           Sheets("Global card").Select
                           Range(i, j).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False

                       f.Name.Range("G8:ZZ8").Select
                           Selection.Copy
                           Sheets("Global card").Select
                           Range(i, j).Select
                           Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
                               ...
                      Je passe à l'onglet suivant
            End if
        End If
    Next f
'    With ActiveSheet
'        .Titre = False: .Cost = False: .Truc = False: .Machin = False
'    End With
End Sub

Pas sûr d'être très clair là aussi mais j'espère un peu car je ne me sors pas pour l'instant

Au secour !

Bonjour à tout le monde,

Bon je n'y arrive toujours pas donc je vais essayer de me renseigner sur un autre forum.

En tous les cas encore merci beaucoup pour votre aide.

A bientôt

Rechercher des sujets similaires à "2010 win recap donnees onglet"