Autres (RESOLU)copie le texte on respectant la forme (renvoie a la ligne automatiquement et ajustement du texte)

chaelie2015

XLDnaute Accro
Bonsoir Forum
Je souhaite copier le texte de la cellule B2 de la feuille1 vers la cellule B2 (fusionnée) de la feuille2, on respectant la mise en forme forme (renvoie a la ligne automatiquement et ajustement du texte)
Merci
 

Pièces jointes

  • Charlie mise en forme.xlsx
    9.7 KB · Affichages: 8
Solution
Bonjour à tous,
Tester le code ci-dessous :
VB:
Sub Copy_Cell()
Dim Source  As Range
Dim I       As Single
    Set Source = Worksheets("Feuil1").[B2]
    Source.Copy
    Worksheets("Feuil2").Select
    With Range(Source.Address).MergeArea
        .Select
        .PasteSpecial Paste:=xlPasteAll
        .PasteSpecial Paste:=xlPasteFormats
        .Merge
        .RowHeight = Source.RowHeight
        I = 0.5: Do
            .ColumnWidth = (Source.ColumnWidth / .Count) * I
            I = I + 0.01
        Loop Until .Width >= Source.Width
    End With
End Sub

Phil69970

XLDnaute Barbatruc
Bonjour @chaelie2015

Je ne suis pas sur que cela soit possible si ta cellule de destination est fusionnée

respectant la mise en forme forme (renvoie a la ligne automatiquement et ajustement du texte)
ET SI
la cellule B2 de la feuille1 vers la cellule B2 (fusionnée) de la feuille2,

Je te propose si la cellule de destination n'est pas fusionnée ce code :

VB:
Sub TestCopie()

Sheets("Feuil1").Range("B2").Copy
Sheets("Feuil2").Range("B2").PasteSpecial Paste:=xlPasteColumnWidths
Sheets("Feuil2").Range("B2").PasteSpecial Paste:=xlPasteAll

End Sub

@Phil69970
 

kellypombal

XLDnaute Nouveau
Bonjour Chaelie2015,

Je ne suis pas sûr que cela soit possible. Le plus simple serait peut être de mettre la forme que tu souhaites sur la feuille 1 et de copier ta feuille 1 (en créant une copie) sur un autre onglet. Ainsi tu as les mêmes caractéristiques et tu n'auras que le texte à modifier.
 

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Tester le code ci-dessous :
VB:
Sub Copy_Cell()
Dim Source  As Range
Dim I       As Single
    Set Source = Worksheets("Feuil1").[B2]
    Source.Copy
    Worksheets("Feuil2").Select
    With Range(Source.Address).MergeArea
        .Select
        .PasteSpecial Paste:=xlPasteAll
        .PasteSpecial Paste:=xlPasteFormats
        .Merge
        .RowHeight = Source.RowHeight
        I = 0.5: Do
            .ColumnWidth = (Source.ColumnWidth / .Count) * I
            I = I + 0.01
        Loop Until .Width >= Source.Width
    End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 100
Messages
2 085 293
Membres
102 853
dernier inscrit
jetstream69