Copier coller un tableau sans formule mais avec formatage

Résolu/Fermé
Yrmouf Messages postés 126 Date d'inscription samedi 4 août 2012 Statut Membre Dernière intervention 22 septembre 2020 - 2 juil. 2013 à 17:49
Yrmouf Messages postés 126 Date d'inscription samedi 4 août 2012 Statut Membre Dernière intervention 22 septembre 2020 - 6 juil. 2013 à 09:35
Bonjour à tous,

J'espère que ma question trouvera sa mariée la réponse! ^^

J'ai ce seul problème qui est le copier/coller d'un tableau qui possède des formules en son sein avec tout un format (cellules fusionnées, couleur, taille, etc...). Mais j'aurais besoin de le coller autre part avec le même formatage mais sans les cellules...

C'est à dire un paste value mais en même temps un paste with formatting source... Et ça n'existe pas on dirait!

Et avec les cellules fusionnées c'est grave galère!

J'avais commencer quelque chose en VBA, mais je ne connais pas très bien encore:

Sub pastevalue()
Range("B7:D7").Copy
Range("A180").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

Voilà, voilà!

Merci d'avance à ceux qui me répondront :)
A voir également:

10 réponses

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 337
5 juil. 2013 à 04:33
Bonjour
Excuse-moi, comme le sujet était passé en résolu, je n'avais pas vu ta dernière remarque.
voici donc la modif apportée concertnant les largeurs et hauteurs

Sub Copie()
    Range("B7:D7").Select
    ZoneSelectionnee = Selection.Address
    Col = ActiveCell.Column
    Lig = ActiveCell.Row
    
    NbLig = Selection.Rows.Count
    NbCol = Selection.Columns.Count
    
    'Relevé des hauteurs et largeurs de cellules
    ReDim LarCol(NbCol) As String
    ReDim HautLig(NbLig) As String
    For c = 1 To NbCol
        LarCol(c) = Columns(Col + c - 1).ColumnWidth
    Next c
    For l = 1 To NbLig
        HautLig(l) = Rows(Lig + l - 1).RowHeight
    Next l
    
    Range(ZoneSelectionnee).Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Range("A180").Select
    ActiveSheet.Paste 'recopie à l'identique
    Col = ActiveCell.Column
    Lig = ActiveCell.Row
    Selection.Offset(NbLig - 1, NbCol - 1).Select
    
    'Restitution des valeurs, remplace les formules par les valeurs
    For i = NbLig To 1 Step -1
        For j = NbCol To 1 Step -1
            Cells(Lig + i - 1, Col + j - 1).Value = Cells(Lig + i - 1, Col + j - 1).Value
        Next j
    Next i
    
    'Restitution des hauteurs et largeurs de cellules
    Range("A1").Select
    For c = 1 To NbCol
        Columns(Col + c - 1).ColumnWidth = CDbl(LarCol(c))
    Next c
    For l = 1 To NbLig
         Rows(Lig + l - 1).RowHeight = CDbl(HautLig(l))
    Next l
End Sub

bonne journée

Cdlt
1