Copier coller qui ne conserve pas le format d'origine

Bonjour à tous, j'ai parcouru de nombreux sujet sur le forum et les solutions proposée ne répondent pas à mon problème.

Je souhaite copier une plage de données d'un onglet de fichier "X" vers une nouvelle page d'un fichier "Y"

j'ai utilisé le code suivant :

ActiveWorkbook.Sheets.Add after:=Sheets("Ligne")
ActiveSheet.Name = "En_cours"
'copie de toute la zone de données
Workbooks("validation.xlsm").ActiveSheet.Range("A1:P500").Copy
Range("A1:P500").PasteSpecial Paste:=xlPasteAll

les couleur de police, encadrement et données valeur sont copiée mais pas les hauteur de ligne ni largeur de colonnes, j'ai donc essayé de décomposer les actions avec le code suivant :

ActiveWorkbook.Sheets.Add after:=Sheets("Ligne")
ActiveSheet.Name = "En_cours"
'copie de toute la zone de données
Workbooks("validation.xlsm").ActiveSheet.Range("A1:P500").Copy
Range("A1:P500").PasteSpecial Paste:=xlPasteValues
Range("A1:P500").PasteSpecial Paste:=xlPasteFormats
Range("A1:P500").PasteSpecial Paste:=xlPasteColumnWidths

les colonnes sont maintenant OK mais pas la hauteur de ligne et pas de XlPasteRowheight.... :)

je sèche totalement, si quelqu'un à une idée?

Merci d'avance et bonne fin de journée à tous

Bonsoir POLBOS Patrick,

Avec une procédure générique de recopie d'une plage source vers une cible : CopierPlage xrgSource , xrgCible :

Sub CopierPlage(xrgSource As Range, xrgCible As Range)
' xrgSource => range de la plage à copier
' xrgcible  => range de la plage cible - seule la cellule du coin supérieur gauche est utile
' on copie la plage xrgSource vers la plage de coin supérieur gauche de xrgCible
' on copie les valeurs, les formats, les hauteurs de lignes, les largeurs de colonnes
Dim i&
   Application.ScreenUpdating = False
   xrgSource.Copy xrgCible(1, 1)
   xrgSource.Copy
   xrgCible(1, 1).PasteSpecial xlPasteValues
   xrgCible(1, 1).PasteSpecial xlPasteColumnWidths
   For i = 1 To xrgSource.Rows.Count: xrgCible(i, 1).EntireRow.RowHeight = xrgSource.Rows(i).RowHeight: Next
   xrgCible(1, 1).Select
End Sub

Et son utilisation :

Sub Test_Recopie()
Dim FeuilCible As Worksheet
   Set FeuilCible = ActiveWorkbook.Sheets.Add(after:=Sheets("Ligne"))
   FeuilCible.Name = "En_cours"
   CopierPlage Workbooks("validation.xlsm").ActiveSheet.Range("a1:p500"), FeuilCible.Range("a1")
End Sub

Bonsoir,

plutôt de copier la plage de cellule dans une nouvelle feuille, pourquoi ne pas copier la feuille ? Est-ce possible ?

Sinon après avoir fait le collage des largeurs de colonne, vous faites une boucle sur les Row de la plage et sur la plage de destination vous faites un réglage de hauteur de ligne égale :

Sub HdeL()
    Dim Plage As Range, PlageDes As Range
    Set Plage = Feuil1.Range("B3:B15")
    Set PlageDes = Feuil3.Range("B3:B15")
    With PlageDes
        For i = 1 To Plage.Rows.Count
            .Rows(i).RowHeight = Plage.Rows(i).RowHeight
        Next i
    End With
End Sub

Il y a peut-être plus simple...

@ bientôt

LouReeD

Merci @mafraise pour l'astuce, @LouReeD, astuce du même acabit et pour répondre à la question auparavant je copiait l'intégralité de la feuille du fichier 1 vers le fichier 2 mais cette feuille contient des boutons associés à des macro et ils étaient copiés avec. Le problème c'est qu'ils restaient attachés à la macro du fichier d'origine et je ne parviens pas à gérer ce point, j'ai essayé de supprimer ces boutons (de 1 à 7) et de les recréer dans le fichier de destination mais ma procédure de création demande la création des boutons 1 à 7 et il semble que malgré la suppression excell les conserve en mémoire paracerque j'ai un message qui m'indique que ces N° sont prix et je ne parviens pas à faire cela en utilisant des N° de bouton dynamique

je vais tester vos deux idées, merci de votre aide je vous tiens informé

Les deux solutions fonctionnent, merci à tous les deux et bonne journée

Bonsoir,

merci @ vous pour ce retour !

@ bientôt

LouReeD