Copier plusieurs tableaux dans aurtant d'onglets

[nonoTT]

Bonjour le Forum
Je dispose de 4 tableaux dans une feuille que je souhaite copier dans autant de feuilles du même classeur à l'exception du dernier tableau que je ne conserve pas.
Chaque tableau se termine par la ligne "TOTAL 2012", cette ligne se retrouvve dans chaque tableau.
Merci de me donner la marche à suivre pour le faire par macro.
Vous trouverez ci-joint le fichier de dépar et le résultat à obtenir.
Cordialemen

 

[Robert]

Re : Copier plusieurs tableaux dans aurtant d'onglets

Bonjour NonoTT, bonjour le forum,

Peut-être avec ces deux macros :

Sub Macro1()
Sheets("export").Range("A1").Select 'sélectionne la cellule A1 de l'onglet "export"
Call CopieTab 'lance la procédure CopieTab
Sheets("export").Activate 'sélectionne l'onglet export
ActiveCell.End(xlDown).Select 'sélectionne la dernière cellule éditée en descendant
ActiveCell.End(xlDown).Select 'sélectionne la première cellule éditée en descendant
Call CopieTab 'lance la procédure CopieTab
Sheets("export").Activate 'sélectionne l'onglet export
ActiveCell.End(xlDown).Select 'sélectionne la dernière cellule éditée en descendant
ActiveCell.End(xlDown).Select 'sélectionne la première cellule éditée en descendant
Call CopieTab 'lance la procédure CopieTab
End Sub

Sub CopieTab()
Dim pl As Range 'déclare la variable pl (PLage)
Dim no As String 'déclare la variable no (Nom de l'Onglet)
Dim o As Object 'déclare la variable o (Onglet)
Set pl = ActiveCell.CurrentRegion 'définit la plage pl
Set pl = pl.Resize(pl.Rows.Count, pl.Columns.Count + 1) 'rajoute la colonne N à la plage
no = pl.Cells(1, 1).Value 'définit le nom de l'onglet (première cellule de la plage)
Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet en dernière position
ActiveSheet.Name = no 'définit le nom du nouvel onglet
Set o = ActiveSheet 'définit l'onglet o
pl.Copy 'copie la plage pl
o.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes
pl.Copy o.Range("A1") 'copie la plage pl et la colle dans A1 du nouvel onglet
o.Range("A1").Select 'sélectionne A1 du nouvel onglet
End Sub

Tu n'a qu'à lancer la procédure Macro1. L'autre, CopieTab, est appelée par la première...

 

[nonoTT]

Re : Copier plusieurs tableaux dans aurtant d'onglets

Bonjour et merci.
Cette macro marche comme je le souhaitait.
En te remerciant.
J'aimerais juste une explication sur comment fonctionne la macro copietab.
Merci

 

[Robert]

Re : Copier plusieurs tableaux dans aurtant d'onglets

Bonjour NonoTT, bonjour le forum,

La macro est commentée, je peux pas faire mieux ! Si un mot te pose problème, tu le sélectionnes et tu appuis sur F1 pour obtenir de l'aide.