Copie automatique de plusieurs onglets dans un seul

[samimi94]

Bonjour à tous,

Je sollicite votre aide pour réaliser un copier-coller automatique de plusieurs onglets vers un autre avec de légères spécificités qui pour vous seront probablement simples mais que je ne sais pas faire.
Je possède des données à la semaine (un onglet = un jour) que je souhaite consolider dans un autre onglet global de manière automatique. Sachant que dans chaque onglet "jour" je possède plusieurs boutiques, je voudrais pouvoir consolider mon fichier global de manière automatique à l'ouverture du fichier si possible en intégrant autant de lignes que de jour par boutique.

Avec un exemple de fichier je pense que cela sera plus parlant. J'ai rempli les lignes de mon onglet générale pour expliquer le résultat voulu mais l’idéal étant de l'automatiser et de ne pas avoir à le saisir.

J'ai un peu de mal à expliquer mon problème donc n'hésitez pas si cela n'est pas très clair.

Merci pour votre aide.
Samimi94.

 

[Robert]

Bonjour Samimi, bonjour le forum,

La macro s'exécutera à chaque ouverture de ton fichier avec :

Private Sub Workbook_Open()
Module1.Macro1 'lance la procédure [Macro1] du module [Module1]
End Sub

Le code :

Option Base 1 'définit 1 comme étant le premier élément d'un tableau (au lieu de 0)

Sub Macro1()
Dim ORS As Worksheet 'déclare la variable ORS (Onglet Région Semaine)
Dim TA() As Variant 'déclare la variable TA (Tableau des Activités)
Dim L As Byte 'déclare la variable L (incrément Ligne)
Dim V As Byte 'déclare la variable V (incrément Ville)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim A As Byte 'déclare la variable A (incrément Activité)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set ORS = Worksheets("Région Semaine") 'définit l'onglet ORS
TA = Array("Rayon 1", "Rayon 2") 'définit le tableau des activités TA
ORS.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes valeurs dans l'onglet ORS
L = 1 'initialise la variable L
For V = 3 To 6 'boucle 1 : sur les 4 villes dans les colonne 3 à 6 (=> colonne C à F)
  For Each O In Sheets 'boucle 2 : sur tous les onglets O du classeur
  If Not O.Name = "Région Semaine" Then 'condition : si l'onglet n'est pas "Région Semaine"
  'si l'onglet ne contient pas de données, va à l'étiquette "suite"
  If O.Range("A1").CurrentRegion.Cells.Count = 1 Then GoTo suite
  TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
  For A = 1 To 2 'boucle 3 : sur les 2 activités
  ReDim Preserve TL(1 To 9, 1 To L) 'redimensionne le tableau des Lignes TL (9 lignes, K colonnes)
  TL(1, L) = TV(1, V) 'récupère dans la ligne 1 de TL, le nom de la ville dans la ligne 1 colonne V de TV
  TL(2, L) = TA(A) 'récupère dans la ligne 2 de TL, l'activité A du tableau TA
  TL(3, L) = O.Name 'récupère dans la ligne 3 de TL, le nom de l'onglet O
  'récupère dans la ligne 4 de TL, en fonction de A, soit la ligne 2, soit la ligne 5 de TV
  TL(4, L) = IIf(A = 1, TV(2, V), TV(5, V))
  'récupère dans la ligne 5 de TL, en fonction de A, soit la ligne 3, soit la ligne 6 de TV
  TL(5, L) = IIf(A = 1, TV(3, V), TV(6, V))
  TL(6, L) = TV(11, V) 'récupère dans la ligne 6 de TL, la donnée ligne 11 colonne V de TV
  TL(7, L) = TV(12, V) 'récupère dans la ligne 7 de TL, la donnée ligne 12 colonne V de TV
  TL(8, L) = TV(13, V) 'récupère dans la ligne 8 de TL, la donnée ligne 13 colonne V de TV
  TL(9, L) = TV(14, V) 'récupère dans la ligne 9 de TL, la donnée ligne 14 colonne V de TV
  L = L + 1 'incrémente L (ajoute une colonne au tableau des lignes TL)
  Next A 'prochaine activité de la boucle 3
  End If 'fin de la condition
suite: 'étiquette
  Next O 'prochain onglet de la boucle 2
Next V 'prochaine ville de la boucle 1
'si L est supérieure à 1, renvoie dans A2 redimensionnée de l'onglet ORS, le tableau TL transposé
If L > 1 Then ORS.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

Le fichier :

 

[samimi94]

Bonsoir Robert, le Forum,

Waouh, un grand merci c'est exactement ce que je cherchais à faire.
A l'ouverture j'ai un debogage sur la ligne :

Set ORS = Worksheets("Région Semaine") 'définit l'onglet ORS

Cependant lorsque je relance le code après ouverture les données sont bien compilées.
S'agit-il d'un paramètre que je dois activer ?
Je suis sous Windows 10, office 365, est-ce lié à ma version ?

Quoiqu'il en soit ce n'est pas bloquant et je suis très reconnaissante pour votre aide précieuse, et ce n'est pas la première fois que vous me sortez une épine du pied.

Un grand merci à vous.

Bonne soirée.
Samimi 94.

 

[Robert]

Re,

C'est étrange ! S'il y a erreur il y a forcément un message d'erreur. Quel est- il ? Est-ce que l'onglet porte exactement le même nom que dans le code (accent, espace en plus, etc.) ?

 

[samimi94]

Bonjour Robert, Le forum,

Le message d'erreur est :
"Erreur d'execution 1004.
La méthode Worksheet de l'objet Global a échoué"
Le nom des onglets est bien le même, j'ai ce message avec le fichier d'origine que tu m'as adressé.

Merci.

Samimi94

 

[Robert]

Re,

J'avoue que je ne comprends pas. C'est d'autant plus bizarre que tu me dis qu'en relançant ça fonctionne alors que la dernière ligne devrait planter :

If L > 1 Then ORS.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)

C'est peut-être, en effet, un problème de version. J'ai remplacé ORS par RS au cas où ORS serait un nouveau mot clé de Visual Basic. Essaie à tout hasard.

Option Base 1 'définit 1 comme étant le premier élément d'un tableau (au lieu de 0)

Sub Macro1()
Dim RS As Worksheet 'déclare la variable RS (onglet Région Semaine)
Dim TA() As Variant 'déclare la variable TA (Tableau des Activités)
Dim L As Byte 'déclare la variable L (incrément Ligne)
Dim V As Byte 'déclare la variable V (incrément Ville)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim A As Byte 'déclare la variable A (incrément Activité)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set RS = Worksheets("Région Semaine") 'définit l'onglet RS
TA = Array("Rayon 1", "Rayon 2") 'définit le tableau des activités TA
RS.Range("A1").CurrentRegion.Offset(1, 0).ClearContents 'efface d'éventuelles anciennes valeurs dans l'onglet RS
L = 1 'initialise la variable L
For V = 3 To 6 'boucle 1 : sur les 4 villes dans les colonne 3 à 6 (=> colonne C à F)
  For Each O In Sheets 'boucle 2 : sur tous les onglets O du classeur
  If Not O.Name = "Région Semaine" Then 'condition : si l'onglet n'est pas "Région Semaine"
  'si l'onglet ne contient pas de données, va à l'étiquette "suite"
  If O.Range("A1").CurrentRegion.Cells.Count = 1 Then GoTo suite
  TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
  For A = 1 To 2 'boucle 3 : sur les 2 activités
  ReDim Preserve TL(1 To 9, 1 To L) 'redimensionne le tableau des Lignes TL (9 lignes, K colonnes)
  TL(1, L) = TV(1, V) 'récupère dans la ligne 1 de TL, le nom de la ville dans la ligne 1 colonne V de TV
  TL(2, L) = TA(A) 'récupère dans la ligne 2 de TL, l'activité A du tableau TA
  TL(3, L) = O.Name 'récupère dans la ligne 3 de TL, le nom de l'onglet O
  'récupère dans la ligne 4 de TL, en fonction de A, soit la ligne 2, soit la ligne 5 de TV
  TL(4, L) = IIf(A = 1, TV(2, V), TV(5, V))
  'récupère dans la ligne 5 de TL, en fonction de A, soit la ligne 3, soit la ligne 6 de TV
  TL(5, L) = IIf(A = 1, TV(3, V), TV(6, V))
  TL(6, L) = TV(11, V) 'récupère dans la ligne 6 de TL, la donnée ligne 11 colonne V de TV
  TL(7, L) = TV(12, V) 'récupère dans la ligne 7 de TL, la donnée ligne 12 colonne V de TV
  TL(8, L) = TV(13, V) 'récupère dans la ligne 8 de TL, la donnée ligne 13 colonne V de TV
  TL(9, L) = TV(14, V) 'récupère dans la ligne 9 de TL, la donnée ligne 14 colonne V de TV
  L = L + 1 'incrémente L (ajoute une colonne au tableau des lignes TL)
  Next A 'prochaine activité de la boucle 3
  End If 'fin de la condition
suite: 'étiquette
  Next O 'prochain onglet de la boucle 2
Next V 'prochaine ville de la boucle 1
'si L est supérieure à 1, renvoie dans A2 redimensionnée de l'onglet RS, le tableau TL transposé
If L > 1 Then RS.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL)
End Sub

 

[samimi94]

Re Robert, le Forum,

Ce seconde code fonctionne du premier coup !
Vous m'étonnerez toujours, sans avoir eu ce message vous savez trouver la solution aussi rapidement.

Mille mercis !

Bonne fin de WE à tous.
Samimi94