Regrouper le contenu de plusieurs feuilles dans une seule

dd54

XLDnaute Nouveau
Bonjour à tous,

Oui je sais, tout le monde se pose la même question ! Le problème c'est que je trouve quelques éléments de réponses mais jamais ce qu'il me faut précisément. Et puis je suis ignorante des codes VBA. Je sais simplement copier-coller un code donné et l'exécuter. Je recherche donc une aide précieuse et complète !

Voilà, j'ai un Plan d'Action composé de plusieurs feuilles excel (plusieurs plan d'action selon le service) et je souhaiterais pouvoir regrouper toutes les actions des différentes feuilles dans une feuille de récap.
Chaque feuille à la même construction, mais le nombre de ligne remplies (actions) diffère.
Attention, j'ai également deux feuilles de notice, qui ne doivent pas êtres prises en compte dans le récap. De même, dans chaque feuille, il y a une en-tête à ne pas prendre en compte. Je peux donner un nom à chaque plage de références à prendre en compte et donc regrouper les données de ces différentes plages.

Ne me proposez pas de tableaux dynamiques, cela ne conviendra pas à l'équipe !

Évidemment il faut que la feuille récap puisse se mettre à jour en fonction de la saisie dans les autres feuilles.

Est-ce que quelqu'un peut m'aider par un super code VBA et explications claires qui vont avec ?

Merci infiniment à mon/mes futurs sauveurs !!!!
 

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Bonjour.
S'il s'agit de tout mettre au bout le bout, ceci dans le module de la feuille résultante devrait faire l'affaire:
VB:
Option Explicit

Private Sub Worksheet_Activate()
Dim Cible As Range, N As Long
Application.ScreenUpdating = False
Me.[2:65536].Delete
Set Cible = Me.[A2]
For N = 1 To Worksheets.Count - 1
With Worksheets(N): .Range("A2:B" & .[A65536].End(xlUp).Row).Copy: End With
Cible.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Cible.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Set Cible = Cible.Offset(Selection.Rows.Count)
Next N
'Me.[A3:H3].Resize(Cible.Row - 3).Sort Key1:=Me.[B3], Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Me.[A1].Select
End Sub
P.S. Remarque: Cette réponse est une copie à 99% de celle à une autre demande très similaire. Les adaptations au problème d'autre feuilles à ignorer ne pourraient se résoudre sans examen d'un classeur joint.
À +
 
Dernière édition:

dd54

XLDnaute Nouveau
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Merci pour votre réponse rapide. Cependant, comme je l'ai dis, je suis novice. J'ai donc copier-coller le code et exécuter. Cela n'a pas fonctionné : erreur "utilisation incorrecte du mot clé ME".

Voici l'idée du fichier excel. Je l'ai simplifié et anonymisé car confidentiel et trop lourd à envoyer !

Merci de votre aide !
 

Pièces jointes

  • modele_forum.xls
    279 KB · Affichages: 227
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

J'ai bien dit:
dans le module de la feuille résultante
Ce n'est que dans un module ordinaire, qu'il ne faut pas employer, qu'il peut y avoir utilisation incorrecte du mot clé Me.
Mettez le code dans le module préexistant de la bonne feuille dans la rubrique "Microsoft Excel Objets"
À +
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Mettez peut être un MsgBox "Ça s'exécute bien !" avant la 1ère autre instruction exécutable pour vérifier que ça s'exécute bien automatiquement à l'activation de la feuille. Si oui, modifiez le code de telle sorte qu'il soit adapté à la structure de vos données existantes pour que le résultat soit bon.
À +
 

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Tant pis pour vous. Si vous ne voulez pas faire l'effort de garnir vos feuilles de quelque données représentatives et construire le modèle exact du résultat souhaité en conséquence, je ne pourrai pas vous aider davantage.
 

dd54

XLDnaute Nouveau
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Ce n'est pas une question d'effort car j'ai fourni le socle.... Vous n'avez pas à connaitre le logo et le contenu du plan d'action, tout ceci est confidentiel. Un plan d'action est un plan d'action. Ce qu'il faut retenir c'est que ce sont des données textuelles ou chiffrées (dates), que les bases ne commencent pas à la première ligne et que toutes les feuilles ne sont pas à prendre en compte. Je ne vois pas comment être plus claire. Le résultat souhaité est la reprise de l'ensemble des bases c'est à dire, dans l'exemple envoyé, un tableau qui reprendrait les même en-tête : Numéro action ; Origine ; Date d'identification ; Responsable de l'action ; Actions … et qui listerait l'ensemble des actions de chaque page.
 

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Bonjour.
Essayez comme ça:
VB:
Option Explicit

Private Sub Worksheet_Activate()
Dim Source As Range, Cible As Range, N As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Me.[2:65536].Delete
Set Cible = Me.[A2]
For N = 3 To Worksheets.Count
   With Worksheets(N): Set Source = .Range("A2:N" & .[B65536].End(xlUp).Row): End With
'   Cible.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'   Cible.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   Source.Copy Destination:=Cible
   Set Cible = Cible.Offset(Source.Rows.Count)
   Next N
Me.[A1].Select
Application.Calculation = xlCalculationAutomatic
End Sub
À +
 

dd54

XLDnaute Nouveau
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Super !!! à quelques détails près :
- Il me copie deux fois les feuilles : Feuille 1 puis Feuille 2 puis Feuille 1 puis Feuille 2
- il intègre les lignes 1 à 5 alors que je ne souhaiterais le report qu'à partir de la ligne des en-tête (ligne 6), une fois seulement, puis les lignes remplies à partir de la ligne 7.

Merci encore !!
 

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Bonjour.
Essayez comme ça:
VB:
Option Explicit

Private Sub Worksheet_Activate()
Dim Source As Range, Cible As Range, N As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Me.[2:65536].Delete
Set Cible = Me.[A1]
Set Source = Worksheets(Me.Index + 1).[A1:N6]
Source.Copy Destination:=Cible
For N = Me.Index + 1 To Worksheets.Count
   Set Cible = Cible.Offset(Source.Rows.Count)
   With Worksheets(N): Set Source = .Range("A7:N" & .[B65536].End(xlUp).Row): End With
   Source.Copy Destination:=Cible
   Next N
Me.[A1].Select
Application.Calculation = xlCalculationAutomatic
End Sub
Efforcez vous de comprendre le code pour le cas où d'autres choses changeraient, que vous soyez capable de le faire vous même.
Utilisez la touche F1 sur les éléments de langage que vous ne comprenez pas.
P.S: Votre feuille cible dans votre vrai classeur ne serait elle pas après les autres par hasard ? Dans ce cas ça ne marcherait plus du tout: Il faudrait: For N = 2 to Me.Index - 1
La seule chose qui expliquerait que les résultats étaient en double, c'est que la feuille résultat elle même était copiée derrière à la fin. Pour que ça ne se reproduise plus il ne faut plus prendre cette feuille elle même dont le rang N = Me.Index
Cordialement.
 
Dernière édition:

dd54

XLDnaute Nouveau
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Et bien, sans attendre votre conseil de "s'efforcer à comprendre le code", je viens de passer 2h30 à trouver la solution qui rejoint effectivement votre complément de réponse posté cet après midi. Ma feuille récap' se trouvant effectivement à la fin.

En tout cas, merci infiniment pour votre aide. Ce code est super et répond à 100% à mon besoin !
Cordialement,



Voici le code trouvé :

Private Sub Worksheet_Activate()
Dim Source As Range, Cible As Range, N As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Me.[2:65536].Delete
Set Cible = Me.[A1]
Set Source = Worksheets(Me.Index - 1).[A6:N6]
Source.Copy Destination:=Cible
For N = 3 To (Me.Index - 1)
Set Cible = Cible.Offset(Source.Rows.Count)
With Worksheets(N): Set Source = .Range("A7:N" & .[B65536].End(xlUp).Row): End With
Source.Copy Destination:=Cible
Next N
Me.[A1].Select
Application.Calculation = xlCalculationAutomatic
End Sub
 

dd54

XLDnaute Nouveau
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Bonjour,

C'est encore moi ! Une petite question, la dernière j'espère, comment faire en sorte que les lignes copiées ne soient que celles pour lesquelles la colonne B est remplie ?

Merci !
:eek:
 

Dranreb

XLDnaute Barbatruc
Re : Regrouper le contenu de plusieurs feuilles dans une seule

Bonjour.
Si elles sont remplies de haut en bas sans trou, ça devrait déjà être le cas. Sinon c'est que des cellules de la colonne B ne sont pas réellement vides mais contiennent un texte de longueur nulle par exemple.
Si par contre il peut y avoir, dans la colonne, B des cellules vides entre les autres (je veux dire RÉELLEMENT vide), pour ne copier que les autres:
VB:
Private Sub Worksheet_Activate()
Dim Source As Range, ZonSrc As Range, Cible As Range, N As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Me.[1:65536].Delete
Set Cible = Me.[A1]
Set Source = Worksheets(Me.Index + 1).[A6:N6] ' Chez vous: "-" au lieu de "+"
Source.Copy Destination:=Cible
For N = Me.Index + 1 To Worksheets.Count ' Chez vous: For N = 3 To (Me.Index - 1)
   For Each ZonSrc In Source.Areas: Set Cible = Cible.Offset(ZonSrc.Rows.Count): Next
   Set Source = Worksheets(N).[B7:B65536]
   Set Source = Intersect(Source.Offset(0, -1).Resize(, 14), _
      Source.SpecialCells(xlCellTypeConstants).EntireRow)
   Source.Copy Destination:=Cible
   Next N
Me.[A1].Select
Application.Calculation = xlCalculationAutomatic
End Sub
À +
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 931
Messages
2 093 721
Membres
105 796
dernier inscrit
Max...26