web-dev-qa-db-fra.com

vba coller des valeurs et conserver le formatage source?

J'essaie de copier et coller une valeur d'une colonne dans un classeur à un autre:

Classeur 1

Column A
10/02/1990
41
11/01/2017
52

Cahier d'exercices 2

Column I
10/02/1990
41
11/01/2017
52

Le problème que j'obtiens est que si je copie simplement mes valeurs de la colonne 1 du classeur A et les colle dans la colonne I du classeur 2. alors j'obtiens des résultats comme ceci:

Column I
34331
41
121092
52

C'est parce que la mise en forme est en quelque sorte perdue/confuse par Excel.

J'ai donc créé un bouton où les utilisateurs peuvent coller ces données en utilisant vba comme ceci:

Sub Paste3()
Dim lastRow As Long
On Error GoTo ErrorHandler

lastRow = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("H10").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False

Exit Sub

ErrorHandler:
MsgBox "Please Copy Values First."
End Sub

Cela fonctionne et les valeurs conservent leur mise en forme. Cependant, le format de cellule change également.

Ce que je veux dire par là, c'est que les cellules du classeur 1 ont une bordure noire et que la police est également en noir et en gras.

Je veux essayer de conserver la police et la bordure de cellule du classeur 2. C'est:

Bordure grise, RVB (191, 191, 191) Police grise (RVB 128, 128, 128) Taille de police: 11 Police: Calibri

Il doit essentiellement ressembler à la colonne de droite.

enter image description here

J'ai essayé cela, mais cela ne fonctionne pas correctement, il ajoute des bordures aux plages dans ma feuille de calcul, il n'est pas censé le faire.

Sub Paste3()
Dim lastRow As Long
On Error GoTo ErrorHandler

lastRow = ActiveSheet.Range("H" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("H10").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False

Dim rng As Range
Set rng = Range("H10:H" & lastRow)
With rng.Borders
        .LineStyle = xlContinuous
        .Color = RGB(191, 191, 191)
        .Weight = xlThin
        .Font
End With

With rng.Font
                .TextColor = RGB(128, 128, 128)
                .Font.Name = "Calibri"
                .Size = 11
                .Bold = False
            End With
Exit Sub

ErrorHandler:
MsgBox "Please Copy Values First."
End Sub

Pour être honnête, je préfère simplement trouver un moyen plus simple de coller ces valeurs et de conserver leur format sans changer le format de la cellule et la couleur de la police, etc.

S'il vous plaît, quelqu'un peut-il me montrer où je me trompe?

excelvbaformat
4
user7415328

Au lieu d'essayer simplement <Paste: = xlPasteAll> une fois

0
Prakhar Srivastava