Microsoft 365 Cherche code de transposition de plusieurs fiches onglet dans un seul onglet

L

lucarn

XLDnaute Occasionnel
Bonjour,
J'ai déjà édité ce sujet, mais les réponses reçues ne fonctionnent pas.
J'ai un fichier avec plusieurs onglets appelés "fiche 1, 2, 3, etc.". Toutes les fiches sont sur le même modèle.
Je veux transposer dans un seul onglet "Rapport", certaines données, toujours les mêmes, de toutes les fiches. En clair un rapport de chaque fiche les uns derrière les autres.
J'ai enregistré une macro avec l'enregistreur automatique qui me permet de transposer les données d'une fiche dans l'onglet "rapport".

Mon problème est que je ne connais pas le code qui permet de mettre tous les rapports de fiche les uns derrière les autres dans l'onglet "Rapport"
Je cherche quelqu'un qui peut me rédiger le code à ajouter à ma macro pour que tous les rapports se mettent les uns derrière les autres.

D'avance merci. Fichier en lien
Voici ma macro

Sub Rapport()
'
' Rapport Macro
'

'
Sheets("Fiche 1").Select
Range("A5").Select
Selection.Copy
Sheets("Rapport").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B6:C6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D20").Select
Sheets("Rapport").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
ActiveWindow.SmallScroll Down:=9
Range("B28:E28").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A3").Select
ActiveSheet.Paste
Range("F3").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "Fréquentation"
With ActiveCell.Characters(Start:=1, Length:=13).Font
.Name = "Trebuchet MS"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -10477568
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("Fiche 1").Select
Range("G29").Select
Selection.Copy
Sheets("Rapport").Select
Range("G3").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
ActiveWindow.LargeScroll Down:=-1
Range("B8:G11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A4").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B13:E13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("C16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("B9").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B19:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A10").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
ActiveWindow.SmallScroll Down:=14
Range("A33:G40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A11").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("A43:G45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A19").Select
ActiveSheet.Paste
Range("K10").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Run "'Lucarn_ED_v02 (1).xlsm'!Macro1"
Sheets("Rapport").Select
Application.Run "'Lucarn_ED_v02 (1).xlsm'!Macro1"
Range("B4").Select
Sheets("Récapitulatif").Select
Rows("1:19").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Application.Run "'Lucarn_ED_v02 (1).xlsm'!Macro1"
Range("BI10").Select
ActiveWorkbook.Close
Rows("1:19").Select
Selection.Delete Shift:=xlUp
Sheets("Rapport").Select
Range("A1:A2").Select
Range("A2").Activate
ActiveWorkbook.Close
Rows("1:22").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
Sheets("Rapport").Select
Range("A1").Select
Application.Run "'Lucarn_ED_v02 (3).xlsm'!Macro1"
Sheets("Récapitulatif").Select
ActiveWorkbook.Close
Range("F23:F24").Select
Range("F24").Activate
Sheets("Rapport").Select
Windows("Fiches essai.xls").Activate
Windows("Fiche action modèle pour Excel downloads.xls").Activate
Application.Run "PERSONAL.XLSB!Rapport"
ActiveWorkbook.Save
ActiveWindow.Close
ActiveWorkbook.Close
ActiveWorkbook.Close
ActiveWorkbook.Close
ActiveWorkbook.Close
ActiveWorkbook.Close
ActiveWorkbook.Close
End Sub
 

Pièces jointes

  • Fiche action modèle pour Excel downloads.xls
    81.5 KB · Affichages: 2
Dernière édition:
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour Lucarn, bonjour le forum,

Peut-être comme ça :
VB: 
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim LI As Integer 'déclare la variable LI (Ligne)

Set OD = Worksheets("Récapitulatif") 'définit l'onglet destination OD
LI = 3 'définit la ligne LI
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeur
    If Left(OS.Name, 5) = "Fiche" Then 'condition : si le nom de l'onglet OS commence par "Fiche"
            OS.Range("B1:G50").Copy 'copie la plage B1:G50
            OD.Cells(LI, 1).PasteSpecial Transpose:=True 'renvoie la plage B1:G50 transposée dans la cellule ligne LI colonne 1 de l'onglet destination OD
            LI = LI + 7 'redéfinit la ligne LI
    End If 'fin de la condition
Next OS 'prochain onglet de la boucle
End Sub
 
Vote positif 0 Vote négatif
L

lucarn

XLDnaute Occasionnel
Robert à dit:
Bonjour Lucarn, bonjour le forum,

Peut-être comme ça :
VB: 
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim LI As Integer 'déclare la variable LI (Ligne)

Set OD = Worksheets("Récapitulatif") 'définit l'onglet destination OD
LI = 3 'définit la ligne LI
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeur
    If Left(OS.Name, 5) = "Fiche" Then 'condition : si le nom de l'onglet OS commence par "Fiche"
            OS.Range("B1:G50").Copy 'copie la plage B1:G50
            OD.Cells(LI, 1).PasteSpecial Transpose:=True 'renvoie la plage B1:G50 transposée dans la cellule ligne LI colonne 1 de l'onglet destination OD
            LI = LI + 7 'redéfinit la ligne LI
    End If 'fin de la condition
Next OS 'prochain onglet de la boucle
End Sub
Cliquez pour agrandir...

Bonjour Robert,
Merci pour ta réponse.
J'ai essayé de suivre tes instructions un peu au pifomètre parce que je suis vraiment trop novice dans le vba.
Voici ce que j'ai fait de la partie que tu m'as donné mais qui ne fonctionne pas car vba me les colorie en rouge. J'ai donc fait des erreurs

Sub Transposer_rapport() tu avais mis Macro1 et moi j'ai repris le nom de ma macro
Dim OS As Worksheet("Fiche") Cette ligne ne va pas. J'ai pris le mot fiche qui revient pour tous les onglets concernés.
Dim OD As Worksheet("Rapport")
Dim LI As Integer(Ligne) Là, je n'ai pas su quoi mettre. Cette ligne correspond à quoi ?

Set OD = Worksheets("Rapport")
LI = 3
For Each OS In Worksheets
If Left(OS.Name, 5) = "Fiche" Then
OS.Range("B1:G50").Copy
OD.Cells(LI, 1).PasteSpecial Transpose:=True
LI = LI + 7
End If
Next OS
End Sub
 
Vote positif 0 Vote négatif
xUpsilon

xUpsilon

XLDnaute Accro
Bonjour,

Les Dim qqchose sont des déclarations de variabe, il faut les laisser telles qu'elles ont été faites par Robert ! (ce qu'il a mis après des ' sont des commentaires pour que tu comprennes quelle variable il attribue pour faire quoi).

Bonne continuation
 
Vote positif 0 Vote négatif
L

lucarn

XLDnaute Occasionnel
Robert à dit:
Bonjour Lucarn, bonjour le forum,

Peut-être comme ça :
VB: 
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim LI As Integer 'déclare la variable LI (Ligne)

Set OD = Worksheets("Récapitulatif") 'définit l'onglet destination OD
LI = 3 'définit la ligne LI
For Each OS In Worksheets 'boucle sur tous les onglets OS du classeur
    If Left(OS.Name, 5) = "Fiche" Then 'condition : si le nom de l'onglet OS commence par "Fiche"
            OS.Range("B1:G50").Copy 'copie la plage B1:G50
            OD.Cells(LI, 1).PasteSpecial Transpose:=True 'renvoie la plage B1:G50 transposée dans la cellule ligne LI colonne 1 de l'onglet destination OD
            LI = LI + 7 'redéfinit la ligne LI
    End If 'fin de la condition
Next OS 'prochain onglet de la boucle
End Sub
Cliquez pour agrandir...

Excuse me, je n'avais pas compris. Pour te dire le niveau... Bref !
J'ai donc collé tel quel mais, visual basic me signale une faute de syntaxe sur la ligne en rouge.
Pour la sub Macro1, faut-il vraiment la laisser avec ce nom car ce qui est bizarre, c'est qu'en faisant comme cela, j'ai la macro 1 qui apparaît dans le liste des macros. Mais, apparemment, ça ne va pas car vba l'a pointé en jaune. Je te mets la capture d'écran
1572441116071.png
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Tu nommes la macro comme tu veux (sans espaces) à partir du moment où dans le même module tu n'as pas deux macros avec le même nom. En pièce jointe ton fichier avec la macro...
 

Pièces jointes

  • Lucarn_ED_v01.xlsm
    38.2 KB · Affichages: 7
Vote positif 0 Vote négatif
L

lucarn

XLDnaute Occasionnel
J'ai posté trop vite ma réponse précédente.
L'erreur de compilation sort parce que j'ai collé ta macro à la suite de la mienne.
Mais j'ai ouvert ton doc avec la macro et j'ai donc activé la macro.
Ce qu'il se passe, c'est que ça transpose l'intégralité de mes fiches. Ca marche très bien.
Sauf que ça n'est pas ça que je veux. Cette macro là, je l'avais déjà pour mon récapitulatif.
Dans mon onglet "rapport", je ne veux que quelques éléments qui se trouvent dans tous les onglets "fiche".
J'avais enregistré la macro pour faire cela avec un onglet et je voulais savoir quoi coller à la suite pour que la macro fasse tous les onglets "fiche".
Mais, comme je te disais plus haut, lorsque je colle ta macro à la suite de la mienne, il y a une erreur de syntaxe. Ca ne marche pas.
 
Vote positif 0 Vote négatif
L

lucarn

XLDnaute Occasionnel
Robert à dit:
Re,

Envoie un fichier avec ce que tu voudrais après exécution de la macro...
Cliquez pour agrandir...
Salut Robert,
Désolé d'avoir été si long.
En fait ce que tu as fait n'a pas de rapport avec ma demande car, tu as travaillé sur l'onglet récapitulatif alors que ma demande concerne l'onglet rapport.
Comme tu l'as demandé, je te mets en pièce jointe mon fichier. Il y a une macro qui s'appelle "Rapport" qui correspond à quelques éléments pris dans chacune des fiches.
Chaque onglet appelé "fiche 1,2, 3etc.", doit faire l'objet d'un rapport. Chaque rapport se met l'un en dessous de l'autre dans l'onglet "rapport" avec une ligne vide entre chaque rapport.
Je me suis servi de l'enregistreur automatique pour faire ma macro. Je vous lais savoir quel code, il fallait mettre derrière mon enregistrement pour que tous les rapports se mettent les unes derrière les autres.
NOte que j'ai plusieurs fichiers qui correspondent à des services différents et qui reprend le même schéma. La macro doit aller sur tous les fichiers.
Je te mets la macro ci-après et le fichier avec ma macro.

Sub Rapport()
'
' Rapport Macro
'

'
Sheets("Fiche 1").Select
Range("A5").Select
Selection.Copy
Sheets("Rapport").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("C5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B6:C6").Select
Application.CutCopyMode = False
Selection.Copy
Range("D20").Select
Sheets("Rapport").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
ActiveWindow.SmallScroll Down:=9
Range("B28:E28").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A3").Select
ActiveSheet.Paste
Range("F3").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -4.99893185216834E-02
.PatternTintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "Fréquentation"
With ActiveCell.Characters(Start:=1, Length:=13).Font
.Name = "Trebuchet MS"
.FontStyle = "Normal"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -10477568
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Range("F3").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("Fiche 1").Select
Range("G29").Select
Selection.Copy
Sheets("Rapport").Select
Range("G3").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
ActiveWindow.LargeScroll Down:=-1
Range("B8:G11").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A4").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B13:E13").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B15").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("C16").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("B9").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("B19:G19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A10").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
ActiveWindow.SmallScroll Down:=14
Range("A33:G40").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A11").Select
ActiveSheet.Paste
Sheets("Fiche 1").Select
Range("A43:G45").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A19").Select
ActiveSheet.Paste
Range("K10").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.Run "'Lucarn_ED_v02 (1).xlsm'!Macro1"
Sheets("Rapport").Select
Application.Run "'Lucarn_ED_v02 (1).xlsm'!Macro1"
Range("B4").Select
Sheets("Récapitulatif").Select
Rows("1:19").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Range("A1").Select
Application.Run "'Lucarn_ED_v02 (1).xlsm'!Macro1"
Range("BI10").Select
ActiveWorkbook.Close
Rows("1:19").Select
Selection.Delete Shift:=xlUp
Sheets("Rapport").Select
Range("A1:A2").Select
Range("A2").Activate
ActiveWorkbook.Close
Rows("1:22").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
Sheets("Rapport").Select
Range("A1").Select
Application.Run "'Lucarn_ED_v02 (3).xlsm'!Macro1"
Sheets("Récapitulatif").Select
ActiveWorkbook.Close
Range("F23:F24").Select
Range("F24").Activate
Sheets("Rapport").Select
Windows("Fiches essai.xls").Activate
Windows("Fiche action modèle pour Excel downloads.xls").Activate
End Sub
 

Pièces jointes

  • Fiche action modèle pour Excel downloads.xls
    97 KB · Affichages: 3
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

Une variante de macro de transposition (qui passe par un Array)
VB: 
Sub Macro1()
Dim ws As Worksheet, t
With Worksheets("Récapitulatif") 'changer le nom feuille selon besoin
For Each ws In Worksheets 'boucle sur toutes les feuilles du classeur
  If ws.Name Like "Fiche*" Then 'condition : si le nom de l'onglet commence par "Fiche"
    t = ws.Range("B1:G50")
    .Cells(Rows.Count, 1).End(3)(3).Resize(UBound(t, 2), UBound(t, 1)).Value = Application.Transpose(t)
    Erase t
  End If
Next ws
End With
End Sub
 
Vote positif 0 Vote négatif
L

lucarn

XLDnaute Occasionnel
Staple1600 à dit:
Bonsoir le fil

Une variante de macro de transposition (qui passe par un Array)
VB: 
Sub Macro1()
Dim ws As Worksheet, t
With Worksheets("Récapitulatif") 'changer le nom feuille selon besoin
For Each ws In Worksheets 'boucle sur toutes les feuilles du classeur
  If ws.Name Like "Fiche*" Then 'condition : si le nom de l'onglet commence par "Fiche"
    t = ws.Range("B1:G50")
    .Cells(Rows.Count, 1).End(3)(3).Resize(UBound(t, 2), UBound(t, 1)).Value = Application.Transpose(t)
    Erase t
  End If
Next ws
End With
End Sub
Cliquez pour agrandir...
Bonjour Staple,
Merci pour ta macro mais elle ne répond pas à ma question. J'avais fait une demande pour cette macro dans un autre fil.
Ce que tu s fait c'est de transposer une fiche en lignes en fiche en colonnes.
Ce que je cherche, c'est créer un rapport e,n lignes de chaque onglet dans un autre onglet, sachant qu'il n'y a que quelques éléments qui sont repris de l'onglet initial.
J'ai fait une macro qui sélectionne ces éléments et qui les mets dans l'onglet rapport.
Mon problème, c'est que je ne connais pas le code pour que tous les rapports se mettent les uns derrière les autres avec une ligne vierge entre chacun.
Mais,je ne sais pas si c'est possible d'ajouter ce code à la fin de ma macro.
Est-ce utile de t'ajouter que je n'y connais quasiment rien...
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

lucarn
Euh What? :eek:
Sur un classeur vierge avec une seule feuille nommée Feuil1, lance la macro ci-dessous
VB: 
Sub Comparaison_Macros()
Dim i
For i = 1 To 3
With Worksheets.Add
.Name = "Fiche " & i
.Range("B1:G50").Formula = "=" & Chr(34) & .Name & " |" & Chr(34) & "&ADDRESS(ROW(),COLUMN(),4)"
End With
Next
Sheets("Feuil1").Name = "Récapitulatif"
End Sub
Puis lance la macro de Robert (celle du message#2)
Observes le résultat sur le feuille Récapitulatif
(puis efface le contenu de la feuille Récapitulatif)
Lance alors ma macro (celle du message#13)

Que constates-tu alors?

Le résultat des deux macros est rigoureusement identique !!!

Et c'est bien ce qu'indiquait la phrase introductive de mon précédent message
Une variante de macro de transposition (qui passe par un Array)
Cliquez pour agrandir...
:rolleyes:
;)
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
262
robpellan52
R
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
97
marie3107
M
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
207
Compte Supprimé 979
C
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
140
marie3107
M
M
  • Résolu(e)
XL 2010 Code VBA pour Appeler un onglet avec texte + variable
Réponses
9
Affichages
412
Phil69970
Phil69970
R
  • Question
XL 2010 Effacement de données dans plusieurs feuilles de calcul dans un même classeur
Réponses
3
Affichages
319
robbynasch
R
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
441
olivier388
O
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
553
Kevin38
K
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
521
mouchtre
mouchtre

Membres actuellement en ligne

13 membres et 210 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 176
Messages
2 085 962
Membres
103 066
dernier inscrit
bobfils