VBA バグ？Number Formatがコピーされない事象

作成中のマクロでバグっぽい事象が確認されたのでメモ。
発生した環境はExcel 2013 32bit on Windows 10 Home 64bit。

マクロというよりは、手でやっても同じことになるので手作業の方を先に紹介。

新規シートを挿入する。
B1セルに時刻を入力する。
A1:B2の2セルを範囲選択してCtrl+Cでコピー
A2セルに張り付ける。

f:id:t-hom:20180611221313p:plain

すると、なぜかシリアル値になる。
f:id:t-hom:20180611221729p:plain

暫くは何度やってもこの事象が再現するのだが、一度B2セル単体でコピーすればもうそのシートでは発生しなくなる。

再現マクロがこちら。

Sub IGuessItIsABug()
    Dim sh As Worksheet
    Set sh = Sheets.Add
    sh.Range("B1").Value = "22:00"
    sh.Range("A1:B1").Copy
    sh.Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

そして、このような処理を行うとバグが回避され、以降そのシートでは再現しなくなる。

Sub WorkAroundForTheIssue()
    Dim sh As Worksheet
    Set sh = Sheets.Add
    sh.Range("B1").Value = "22:00"

    '予めB2に個別に張り付けておく
    sh.Range("B1").Copy
    sh.Range("B2").Select
    ActiveSheet.Paste

    'A2に貼り付ける。
    sh.Range("A1:B1").Copy
    sh.Range("A2").Select
    ActiveSheet.Paste
    
    'A4に張り付けても事象は発生しなくなっている。
    sh.Range("A1:B1").Copy
    sh.Range("A4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    '以降、このシートでは同事象は発生しなくなる。
    '別のセルでも同じように、成功する。
End Sub

ちなみにコピー範囲の先頭にNumberFormatがある場合は再現しない。

Sub NoBugPattern()
    Dim sh As Worksheet
    Set sh = Sheets.Add
    sh.Range("A1").Value = "22:00"
    sh.Range("A1:B1").Copy
    sh.Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

なにこれ。

追記

Twitterに事象を投げたところ羽毛田さん(サイト)が検証してくれたが、やはりバグのようだ。

とりあえずActiveSheetに対するBug回避用のコードを追記。

Sub BugAvoidanceForNumberFormatCopyFail()
    Dim r As Range: Set r = ThisWorkbook.ActiveSheet.Cells(1, 1)
    Do Until r.Value = "" And r.Offset(1, 0).Value = ""
        Set r = r.Offset(1, 0)
    Loop
    r.Value = Date
    r.NumberFormat = "hh:mm:ss"
    r.Copy r.Offset(1, 0)
    Range(r, r.Offset(1, 0)).ClearContents
'Rem Reproducible bug code are below.
'Sub NumberFormatCopyFail
'    With ThisWorkbook.Sheets.Add
'        .Range("B1").Value = "22:00"
'        .Range("A1:B1").Copy
'        .Range("A2").Select
'    End With
'    ActiveSheet.Paste
'    Application.CutCopyMode = False
'End Sub
End Sub