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

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:

lucarn

XLDnaute Occasionnel
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

:rolleyes:
;)
Bonjour Stapple,
Bon, j'ai suivi tes directives mais vu que je suis un ignare, je ne comprends rien au résultat et donc ne sait quoi en faire.
D'autre part, tu parles de la feuille "récapitulatif" alors que je parle de la feuille "rapport".
J'ai enregistré une macro, fort longue, puisque je suis passé par l'enregistreur automatique. Je veux juste savoir s'il faut un code en fin de macro pour que toutes les données de chaque feuille se mettent les unes derrière les autres dans la feuille "rapport" ? Et quel est ce code ?
Désolé d'être lourdingue
 

Discussions similaires

Statistiques des forums

Discussions
312 107
Messages
2 085 356
Membres
102 874
dernier inscrit
Petro2611