Copier coller un tableau sans formule mais avec formatage Résolu/Fermé

Question

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 :)

Frenchie83 · Answer

Bonjour
 essayez ceci
Sub Copie()
    Range("B7:D7").Select
    NbLig = Selection.Rows.Count
    NbCol = Selection.Columns.Count
    Selection.Copy
    Range("A180").Select
    ActiveSheet.Paste
    Col = Range("B7").Column
    Lig = Range("B7").Row
    Range("B7").Select
    Selection.Offset(NbLig - 1, NbCol - 1).Select
    
    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
End Sub

bonne réception
Cdlt

Patrice33740 · Answer

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

Frenchie83 · Answer

Re 

remplacez le précédent envoi par celui-ci, en recopiant j'ai oublié de changer certaines valeurs

Sub Copie()
    Range("B7:D7").Select
    NbLig = Selection.Rows.Count
    NbCol = Selection.Columns.Count
    Selection.Copy
    Range("A180").Select
    ActiveSheet.Paste
    Col = Range("A180").Column
    Lig = Range("A180").Row
    Range("A180").Select
    Selection.Offset(NbLig - 1, NbCol - 1).Select
    
    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
End Sub

cdlt

Yrmouf · Answer

Bonjour Frenchie, bonjour Patrice,

Merci pour votre aide.

Ta solution Frenchie marche fabuleusement bien! Toutefois, tous mes textes et liens vers une autre feuille disparaisse sans laisser les valeurs.

Par exemple en cellule D7, c'était écrit ="AllDatas!M3" avec un texte qui apparaissait. Et là, à travers la macro, je n'ai plus qu'un 0 qui est afficher, pareil pour quand c'est un chiffre. 

Merci d'avance pour l'aide!

Frenchie83 · Answer

Bonjour

Si c'est possible, il faudrait que tu fixes les formules des cellules à recopier avec F4 
exemple: remplacer =AllDatas!M3 par =AllDatas!$M$3

Si ce n'est pas possible, il faudra repenser les système

j'attends ta réponse

A+

Yrmouf · Answer

Rebonjour Frenchie,

Merci pour tes promptes et efficaces réponses, cela fonctionne très bien!

En revanche y a t-il une écriture si je veux conserver la taille des cellules à l'identique sur une autre feuille?

C'est à dire quand j'effectue: 

    Sheets.Add After:=Sheets(Sheets.Count)

Pas grave sinon la remise en page est pas trop longue!

Merci pour tout en tout cas :)

Frenchie83 · Answer

Re

Je ne suis pas sûr d'avoir bien compris le sens de ta question.
toutefois, j'ai glissé ta commande d'ajout de feuille, et refais la manip avec des formats différents (taille et police) . tout va bien, la recopie se fait parfaitement tout en respectant les formats.

si ce n'est pas ça, réexplique - moi

Sub Copie()
    Range("B7:D7").Select
    NbLig = Selection.Rows.Count
    NbCol = Selection.Columns.Count
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Range("A180").Select
    ActiveSheet.Paste
    Col = Range("A180").Column
    Lig = Range("A180").Row
    Range("A180").Select
    Selection.Offset(NbLig - 1, NbCol - 1).Select
    
    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
End Sub

A+

Yrmouf · Answer

Oui pardon, je me suis mal exprimé. 

En fait quand je parlais de la taille ce n'était pas la taille de l'écriture mais la taille des cellules, par exemple j'ai des largeurs spécifiques à mes colonnes ou des hauteurs spécifique à mes lignes.

Ainsi, dès lors que la macro s'effectue sur une autre page, il me copie bien les cellules mais avec les largeurs et les hauteurs d'origines, en revanche le format écriture et les couleurs sont bien conservés!

Merci !

Frenchie83 · Answer

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

Yrmouf · Answer

Aucun soucis à cela, je pensais enregistrer une macro qui aurait fait toutes les mises en pages par la suite, pas très handy certes...

Super pour ta solution! Merci beaucoup pour ton temps, je n'aurais définitivement pas trouver seul avant un bon moment.

Bonne journée à toi aussi et merci encore!

Copier coller un tableau sans formule mais avec formatage

10 réponses

Discussions similaires