Union de plusieurs plages sur une autres feuille

[ivan27]

Bonjour à tous,

Ci-joint un classeur exemple.
Je souhaite réunir sur la feuille "Recap" des données présentes sur les autres feuilles, en fonction de la valeur inscrite en B5.
J'ai bien trouver un début de réponse sur le forum avec la méthode union, mais je n'arrive pas à l'adapter à mon cas.
Merci d'avance pour vos propositions.
Cordialement

Ivan

 

[pierrejean]

Re : Union de plusieurs plages sur une autres feuille

Bonjour ivan27

Vois si cela te convient (par Vba)

 

[ivan27]

Re : Union de plusieurs plages sur une autres feuille

Bonjour pierrejean,

Merci pour ta proposition mais je suis sur mac avec excel 2011 qui, à priori, n'est pas compatible avec les dictionnaires.
Bien cordialement,

Ivan

 

[job75]

Re : Union de plusieurs plages sur une autres feuille

Bonjour ivan27, hello Pierre,

Placer dans le code de la feuille "Recap" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Activate()
'adapter éventuellement les références A3 B5 A8
Dim c As Range, v, w As Worksheet, h&
Application.ScreenUpdating = False
For Each c In [A3].CurrentRegion.Rows(1).Cells
  c(2).Resize(Rows.Count - c.Row).ClearContents 'RAZ de la colonne
  v = c
  For Each w In Worksheets
    If w.Name <> Me.Name And w.[B5] = v Then
      With w.[A8].CurrentRegion.Columns(1)
        If .Cells(1) <> "" Then
          h = .Rows.Count
          c(2).Resize(h) = .Value
          Set c = c.Offset(h)
        End If
      End With
    End If
  Next
Next
End Sub

La macro se lance quand on active la feuille.

A+

 

[job75]

Re : Union de plusieurs plages sur une autres feuille

Re,

La macro précédente avec les CurrentRegion suppose que les lignes au dessus de A3 et des A8 sont vides.

Si ce n'est pas toujours le cas on peut utiliser :

Private Sub Worksheet_Activate()
Dim c As Range, v, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
For Each c In Rows(3).SpecialCells(xlCellTypeConstants)
  c(2).Resize(Rows.Count - c.Row).Clear 'RAZ de la colonne
  v = c
  For Each w In Worksheets
    If w.Name <> Me.Name And w.[B5] = v Then
      With w.Range("A8:A" & w.Rows.Count).SpecialCells(xlCellTypeConstants)
        .Copy c(2)
        Set c = c.Offset(.Count)
      End With
    End If
  Next
Next
End Sub

Edit : Clear au lieu de ClearContents pour effacer aussi les formats.

A+

 

[pierrejean]

Re : Union de plusieurs plages sur une autres feuille

Re

Hello Gerard

Peut-être est-il bon de préciser qu'en ligne 3 de Recap doivent déjà figurer Valeur1 Valeur2 Valeur3

A noter qu'il n’est pas trop complexe de les recuperer

 

[ivan27]

Re : Union de plusieurs plages sur une autres feuille

Bonsoir job75, pierrejean, le forum

job75, ta deuxième proposition fonctionne parfaitement sur mon mac.

Est-il possible d'apporter une modification pour que la copie ne concerne que les données sans le formatage des cellules ?

Bien cordialement,

Ivan

 

[job75]

Re : Union de plusieurs plages sur une autres feuille

Re,

Peut-être est-il bon de préciser qu'en ligne 3 de Recap doivent déjà figurer Valeur1 Valeur2 Valeur3

En effet Pierre c'est ce que j'avais supposé, mais sinon on peut les récupérer (sans Dictionary) :

Private Sub Worksheet_Activate()
Dim c As Range, w As Worksheet, v, i, c1 As Range, w1 As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de Specialcells
Rows(3).ClearContents 'RAZ qui conserve les formats
Rows("4:" & Rows.Count).Delete 'RAZ
Set c = [A3]
For Each w In Worksheets
  If w.Name <> Me.Name Then
    v = w.[B5]
    i = Application.Match(v, Rows(3), 0)
    If v <> "" And IsError(i) Then
      c = v: Set c1 = c: Set c = c(, 2)
      For Each w1 In Worksheets
        If w1.Name <> Me.Name And w1.[B5] = v Then
          With w1.Range("A8:A" & w1.Rows.Count).SpecialCells(xlCellTypeConstants)
            .Copy c1(2)
            Set c1 = c1.Offset(.Count)
          End With
        End If
      Next
    End If
  End If
Next
'---tri de gauche à droite sur ligne 3---
Rows("3:" & Rows.Count).Sort Rows(3), xlAscending, Orientation:=xlLeftToRight
End Sub

A+

 

[ivan27]

Re : Union de plusieurs plages sur une autres feuille

Re bonsoir job75,

Le code du post 5 respecte les entêtes de colonnes et il fonctionne parfaitement même si j'ai d'autres feuilles qui ne sont pas concernée par la récupération de données dans la mesure où la cellule B5 ne contient pas une valeur identique aux cellules A, B et C3 de la feuille recap.

Par contre le code du post 8 copie des données fantaisistes, supprime les entêtes et provoque un décalage vers la droite.

Bien cordialement,

Ivan

 

[job75]

Re : Union de plusieurs plages sur une autres feuille

Re,

Est-il possible d'apporter une modification pour que la copie ne concerne que les données sans le formatage des cellules ?

Macro du post #5 modifiée avec un collage spécial valeurs :

Private Sub Worksheet_Activate()
Dim c As Range, v, w As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de SpecialCells
For Each c In Rows(3).SpecialCells(xlCellTypeConstants)
  c(2).Resize(Rows.Count - c.Row).ClearContents 'RAZ de la colonne
  v = c
  For Each w In Worksheets
    If w.Name <> Me.Name And w.[B5] = v Then
      With w.Range("A8:A" & w.Rows.Count).SpecialCells(xlCellTypeConstants)
        Application.CutCopyMode = 0
        .Copy
        c(2).PasteSpecial xlPasteValues 'collage special valeurs
        Set c = c.Offset(.Count)
      End With
    End If
  Next
Next
Application.CutCopyMode = 0
[A1].Select
End Sub

Macro du post #8 modifiée avec un collage spécial valeurs :

Private Sub Worksheet_Activate()
Dim c As Range, w As Worksheet, v, i, c1 As Range, w1 As Worksheet
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de Specialcells
Rows("3:" & Rows.Count).ClearContents 'RAZ
Set c = [A3]
For Each w In Worksheets
  If w.Name <> Me.Name Then
    v = w.[B5]
    i = Application.Match(v, Rows(3), 0)
    If v <> "" And IsError(i) Then
      c = v: Set c1 = c: Set c = c(, 2)
      For Each w1 In Worksheets
        If w1.Name <> Me.Name And w1.[B5] = v Then
          With w1.Range("A8:A" & w1.Rows.Count).SpecialCells(xlCellTypeConstants)
            Application.CutCopyMode = 0
            .Copy
            c1(2).PasteSpecial xlPasteValues 'collage special valeurs
            Set c1 = c1.Offset(.Count)
          End With
        End If
      Next
    End If
  End If
Next
'---tri de gauche à droite sur ligne 3---
Rows("3:" & Rows.Count).Sort Rows(3), xlAscending, Orientation:=xlLeftToRight
[A1].Select
End Sub

A+

 

[job75]

Re : Union de plusieurs plages sur une autres feuille

Re,

Par contre le code du post 8 copie des données fantaisistes, supprime les entêtes et provoque un décalage vers la droite.

Bien sûr car il copie des feuilles non concernées.

Pour y remédier il suffit de remplacer le test If w.Name <> Me.Name par un plus adapté.

Du genre If w.Name Like "Feuil" & "*"

A+

 

[job75]

Re : Union de plusieurs plages sur une autres feuille

Bonjour ivan27, Pierre, le forum,

Si les feuilles à copier sont immuables on peut lister leurs CodeNames :

Private Sub Worksheet_Activate()
Dim c As Range, a, w, v, i, c1 As Range, w1
Application.ScreenUpdating = False
On Error Resume Next 's'il n'y a pas de Specialcells
Rows("3:" & Rows.Count).ClearContents 'RAZ
Set c = [A3]
a = Array(Feuil1, Feuil2, Feuil3, Feuil4, Feuil5, Feuil6, Feuil7) 'CodeNames
For Each w In a
  v = w.[B5]
  i = Application.Match(v, Rows(3), 0)
  If v <> "" And IsError(i) Then
    c = v: Set c1 = c: Set c = c(1, 2)
    For Each w1 In a
      If w1.[B5] = v Then
        With w1.Range("A8:A" & w1.Rows.Count).SpecialCells(xlCellTypeConstants)
          Application.CutCopyMode = 0
          .Copy
          c1(2).PasteSpecial xlPasteValues 'collage special valeurs
          Set c1 = c1.Offset(.Count)
        End With
      End If
    Next
  End If
Next
'---tri de gauche à droite sur ligne 3---
Rows("3:" & Rows.Count).Sort Rows(3), xlAscending, Orientation:=xlLeftToRight
[A1].Select
End Sub

Noter que dans ce cas il ne faut pas déclarer w et w1 As Worksheet.

Bonne journée et A+

 

[ivan27]

Re : Union de plusieurs plages sur une autres feuille

Bonsoir job75, le forum,

Merci pour ton aide et cette précision très utile.
Bien cordialement,

Ivan