Consolidation de données

Merlin258413 · 11 Mars 2019

Bonjour à tous
J'ai un fichier excel ci joint je désire consolider dans l'onglet "CONSO" toutes les données des onglets en jaune et donc exclure les autres comme paramètre.
J'ai ce code mais il doit me manque la partie exclusion pouvez vous m'aider svp ?
En vous remerciant par avance et excellente journée

VB:

Sub Consolide()
Dim NbLg As Long
Dim Ws As Worksheet

  With Sheets("CONSO")
    If .Range("A2") <> "" Then
      .Range("A2:AG" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    End If
    For Each Ws In Sheets
      Select Case Ws.Name
        Case "CONSO"
        Case Else
          If Ws.Range("A2") <> "" Then
            NbLg = Ws.Range("A" & Rows.Count).End(xlUp).Row
            Ws.Range("A2:AG" & NbLg).Copy _
                  Destination:=.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
          End If
      End Select
    Next Ws
  End With
 
End Sub

eriiic · 11 Mars 2019

Bonjour,

avec 0 données la consolidation est vite faite
Pourquoi par macro, 'Données / Outils de données / Consolider' ne fonctionne pas ?

eric

Merlin258413 · 11 Mars 2019

Bonjour je pensais que la trame du fichier et mon code suffisaient.
Je passe par macro car je ne sais pas utiliser l'outil de données consolider je vais essayer de m'y pencher si je peux consolider plusieurs onglets
merci

zebanx · 11 Mars 2019

Bonjour à tous

@Merlin258413
Pour l'exclusion, sans avoir testé le code, pensez à quelque chose comme

Dans votre code : If Ws.Range("A2") <> "" Then
à remplacer par : If Ws.Range("A2") <> "" and Ws.Tab.Color = vbYellow Then

Un exemple joint utilisant cette instruction.
Bonne finalisation.

@+

Merlin258413 · 11 Mars 2019

Bonjour merci cela fonctionne pourrait on faire cela avec les noms des feuilles
En vous remerciant

zebanx · 11 Mars 2019

Re,

Un essai. Ma version excel ne comporte pas les segments, j'ai désactivé la fin du code.
La macro a lancé s'appelle "consolide2" (dans le module 2) avec les noms de feuilles AK1, AK2, AK3 modifiables dans l'array.

@+

VB:

Sub Consolide2()
Dim NbLg As Long
Dim Ws As Worksheet

A = Array("AK1", "AK2", "AK3")

  With Sheets("CONSO")
    If .Range("A2") <> "" Then
      .Range("A2:AG" & .Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    End If
    For Each Ws In Sheets
      Select Case Ws.Name
        Case "CONSO"
        Case Else
          For n = LBound(A) To UBound(A)
            If Ws.Range("A2") <> "" And Ws.Name = A(n) Then
            NbLg = Ws.Range("A" & Rows.Count).End(xlUp).Row
            Ws.Range("A2:AG" & NbLg).Copy _
                  Destination:=.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
         Next n
      End Select
    Next Ws
  End With
  End sub

Merlin258413 · 12 Mars 2019

Bonjour je vous remercie pour votre réponse, je la teste et je reviens vers vous
Encore un grand merci

Consolidation de données

Merlin258413

XLDnaute Occasionnel

Pièces jointes

eriiic

XLDnaute Barbatruc

Merlin258413

XLDnaute Occasionnel

zebanx

XLDnaute Accro

Pièces jointes

Merlin258413

XLDnaute Occasionnel

zebanx

XLDnaute Accro

Pièces jointes

Merlin258413

XLDnaute Occasionnel

Discussions similaires