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

Signaler
Messages postés
128
Date d'inscription
samedi 4 août 2012
Statut
Membre
Dernière intervention
22 septembre 2020
-
Messages postés
128
Date d'inscription
samedi 4 août 2012
Statut
Membre
Dernière intervention
22 septembre 2020
-
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 :)

10 réponses

Messages postés
2197
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
18 février 2021
313
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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
2197
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
18 février 2021
313
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
Messages postés
8435
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
20 février 2021
1 610
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
Messages postés
2197
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
18 février 2021
313
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
Messages postés
128
Date d'inscription
samedi 4 août 2012
Statut
Membre
Dernière intervention
22 septembre 2020
4
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!
Messages postés
2197
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
18 février 2021
313
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+
Messages postés
128
Date d'inscription
samedi 4 août 2012
Statut
Membre
Dernière intervention
22 septembre 2020
4
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 :)
Messages postés
2197
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
18 février 2021
313
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+
Messages postés
128
Date d'inscription
samedi 4 août 2012
Statut
Membre
Dernière intervention
22 septembre 2020
4
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 !
Messages postés
128
Date d'inscription
samedi 4 août 2012
Statut
Membre
Dernière intervention
22 septembre 2020
4
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!