Autres Une macro pour transposer des onglets dans un seul onglet à la suite

Bonjour
essaie ceci

Sub cop()
With Sheets("Récapitulatif")
.Range(.Cells(3, 1), .Cells(.UsedRange.Rows.Count, 50)).Delete
End With
nf = 0
For Each f In Sheets
If Left(f.Name, 5) = "Fiche" Then
Set zone = f.Range(f.Cells(1, 3), f.Cells(50, 7))
Call col(zone, nf)
nf = nf + 1

End If

Next
End Sub

Sub col(zone, nf)
With Sheets("Récapitulatif")
zone.Parent.Activate
zone.Copy
.Cells(nf * 6 + 3, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


End With
End Sub

Bonjour Sousou et merci pour ta réponse.
J'ai donc copié collé ta formule à la place de ma formule de macro.
Je ne sais pas si c'est bien cela qu'il fallait faire.
J'ai un message qui me dit :
"erreur de compilation, End sub attendu"
Bonne journée

Bonjour
Tu as certainement oublié quelque chose

Bonjour Sousou,
C'est bon, j'ai réussi.
J'abuse de ton aide.
Toujours, à partir du même doc, je veux prendre certains éléments et les redistribuer dans une feuille rapport.
Je suis passé par enregistrement manuel et donc, j'ai la base des éléments à prendre et celle de leur rangement.
Mon problème est toujours le même, à savoir, que toutes les fiches soient traitées de la même façon les unes en dessous des autres.
Le langage VBA est vraiment difficile pour moi, et je n'ai pas réussi à reprendre dans ta macro, la ou les "phrases" qui indiquent qu'il faut ajouter les fiches les unes derrière les autres en laissant une ligne vierge entre chaque fiche.
Peux-tu me donner la formule ?
Voici la macro que j'ai enregistrée à laquelle je voudrais ajouter la formule :

Sub Transposer_rapport()
'
' Transposer_rapport Macro
'

'
Windows("PERSONAL.XLSB").Activate
Windows("Fiches action Arts vivants.xls").Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A3").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("D8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("C4").Select
ActiveSheet.Paste
Range("A5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Du "
Sheets("Fiche Spectacle").Select
Range("C15").Select
Selection.Copy
Sheets("Rapport").Select
Range("B5").Select
ActiveSheet.Paste
Range("C5").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "au"
Range("C5").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D5").Select
Sheets("Fiche Spectacle").Select
Range("C16").Select
Selection.Copy
Sheets("Rapport").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("B18:C18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A6").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("B19:C19").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("D6").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
ActiveWindow.SmallScroll Down:=9
Range("C22").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Prestataire"
Range("B7").Select
Sheets("Fiche Spectacle").Select
Selection.Copy
Sheets("Rapport").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("B28:G28").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A8").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("B29:G30").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A9").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
ActiveWindow.SmallScroll Down:=25
Range("B45:G47").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A11").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
Range("B51:G53").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A14").Select
ActiveSheet.Paste
Sheets("Fiche Spectacle").Select
End Sub

D'avance un grand merci

Explique ce que tu souhaites à partir du fichier! le code enregistré c'est trop long
DE bonnes phrases un exemple, et ca doit suffir sinon comment veux-tu qu'on s"y retrouve
et travail avec le même fichier ue celui que tu as poster

Bonjour l'enregistreur de Macros.....

lucarn à dit:

Windows("Fiches action Arts vivants.xls").Activate
Range("C7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Rapport").Select
Range("A3").Select
ActiveSheet.Paste

Cliquez pour agrandir...

Si tu veux que ton code s’exécute plus rapidement évites les .Select et .Activate.
Un simple C'est ce bout de code qui permet de mettre les fiches les unes derrière les autres
Donc si tu veux une ligne blanche remplace 6 par 7 dans la mesure ou tes fiches se terminent à la colonne G
Merci à sousou pour ce bout de code qui est une approche à laquelle je n'aurais pas pensé.

bonjour
essayez ce code là
Private Sub CommandButton1_Click()

Dim lg, ws As Worksheet, f As Worksheet
Set f = Sheets("synthese")
f.Range("a2:d" & f.[a65000].End(xlUp).Row).ClearContents 'efface Récap

For Each ws In Worksheets
If ws.Name <> "Feuil1" And ws.Name <> "synthese" And ws.Name <> "journal mvt" And ws.Name <> "baseadrien" And ws.Name <> "liste site" And ws.Name <> "base nom" And ws.Name <> "recherche par palette" And ws.Name <> "code barre" And ws.Name <> "pc deja reactivés" Then 'feuilles à ne pas traiter
lg = ws.Range("a" & Rows.Count).End(xlUp).Row
ws.Range("a1:e" & lg).Copy Destination:= _
f.Range("a" & Rows.Count).End(xlUp)(2)
End If
Next
Sheets("synthese").Range("E2:e10000").ClearContents
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Feuil1" And ws.Name <> "synthese" And ws.Name <> " journal mvt" And ws.Name <> "baseadrien" And ws.Name <> "liste site" And ws.Name <> "base nom" And ws.Name <> "recherche par palette" And ws.Name <> "code barre" And ws.Name <> "pc deja reactivés" Then
For I = 1 To Sheets("synthese").Range("A1")(Rows.Count, 1).End(xlUp).Row
If Application.CountIf(Sheets(ws.Name).Range("a:a"), Range("a" & I)) = 1 Then Range("e" & I) = ws.Name
Next
End If
Next

il faut modifier les noms des onglets

sousou à dit:

Explique ce que tu souhaites à partir du fichier! le code enregistré c'est trop long
DE bonnes phrases un exemple, et ca doit suffir sinon comment veux-tu qu'on s"y retrouve
et travail avec le même fichier ue celui que tu as poster

Cliquez pour agrandir...

Bonjour Sousou,

Effectivement, je n'ai pas mis le fichier car la macro que j'ai mise je l'ai faite à partir du même fichier que celui sur lequel tu m'as aidé. Valtrase et Silguy m'ont répondu, ça devrait fonctionner. Merci

valtrase à dit:

Bonjour l'enregistreur de Macros.....

Si tu veux que ton code s’exécute plus rapidement évites les .Select et .Activate.
Un simple

VB:

WorkSheet("Toto").range("A1").Value = WorkSheet("Truc").Range("B1").Value

C'est ce bout de code qui permet de mettre les fiches les unes derrière les autres

VB:

.Cells(nf * 6 + 3, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Donc si tu veux une ligne blanche remplace 6 par 7 dans la mesure ou tes fiches se terminent à la colonne G
Merci à sousou pour ce bout de code qui est une approche à laquelle je n'aurais pas pensé.

Cliquez pour agrandir...

Bonjour Valtrase,
et merci pour ta réponse.
Cependant, ça ne fonctionne pas, j'ai un message d'erreur.
J'ai essayé 2 solutions
La première où j'ai recopié ta phrase après ma macro. Cela donne


End Sub

Du coup j'ai repris toute la fin de la formule de Sousou et j'ai donc ajouté cela à ma macro

End If

Next
End Sub

Sub col(zone, nf)
With Sheets("Récapitulatif")
zone.Parent.Activate
zone.Copy
.Cells(nf * 7 + 3, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


End With
End Sub

Mais, j'ai encore un message d'erreur.
Du coup, je suis en stand by. Si tu as quelques minutes...

J'essaye de suivre les conseils de Valtrase, mais je coince dès le premier code qui permet de code qui permet de mettre les fiches les unes derrière les autres dans l'onglet rapport
Voici le code de Valtrase :
WorkSheet("Toto").range("A1").Value = WorkSheet("Truc").Range("B1").Value
Je ne sais par quoi remplacer Toto et Truc.vJ'ai beau avoir essayé plusieurs solutions, ça coince.

Pour récapituler, je veux mettre des éléments de mes onglets "fiche1", "fiche2", "fiche3", etc. " dans l'onglet "rapport".

Bonjour,

Toto et Truc doivent être remplacé par les noms des onglets concernés.
Et aussi, je pense que Worksheets("Blablabla") fonctionnera mieux.

Bonne continuation

xUpsilon à dit:

Bonjour,

Toto et Truc doivent être remplacé par les noms des onglets concernés.
Et aussi, je pense que Worksheets("Blablabla") fonctionnera mieux.

Bonne continuation

Cliquez pour agrandir...

Merci xUpsilon. Effectivement, je n'ai plus le message d'erreur. Mais, je suis loin du compte.
Je ne sais pas si tu as regardé la macro que j'ai faite avec l'enregistreur qui consiste à reprendre des éléments des onglets qui s'appellent tous "fiche 1, 2, 3 etc" pour les coller dans l'onglet "rapport" les éléments de fiches les uns derrière les autre et séparés d'une ligne.
Je voulais avoir la formule complète (je n'y connais strictement rien en vba) à coller à la suite de ma macro.
On m'a donné des réponses mais, ça ne fonctionne pas.

Bonjour
Alors tu en es où? j'ai un peu de mal à suivre