web-dev-qa-db-ja.com

vba値を貼り付け、ソースのフォーマットを維持しますか?

あるワークブックの列から別のワークブックに値をコピーして貼り付けようとしています:

ワークブック1

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

ワークブック2

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

私が得ている問題は、ワークブックAの列1から自分の値をコピーして、ワークブック2の列Iに貼り付けるだけの場合、次のような結果が得られます。

Column I
34331
41
121092
52

これは、Excelによって書式設定が何らかの形で失われたり混乱したりするためです。

そこで、ユーザーが次のようにvbaを使用してこのデータを貼り付けることができるボタンを作成しました。

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

これは機能し、値はフォーマットを維持します。ただし、セルの形式も変更されます。

つまり、ワークブック1のセルには黒い境界線があり、フォントも黒く太字です。

ブック2のフォントとセルの境界線を維持したいと思っています。これは:

灰色の境界線、RGB(191、191、191)灰色のフォント(RGB 128、128、128)フォントサイズ:11フォント:Calibri

基本的には、右の列のように見える必要があります。

enter image description here

私はこれを試しましたが、正しく機能しません。スプレッドシートの範囲に境界線が追加され、想定されていません。

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

正直に言うと、セルのフォーマットやフォントの色などを変更せずに、これらの値を貼り付けてフォーマットを維持する簡単な方法を見つけたいだけです。

私が間違っているところを誰かに見せてもらえますか?

4
user7415328

<Paste:= xlPasteAll>を一度だけ試すのではなく

0