【VBS】Excelセルコピーが画像（？）になってしまう

Question

以下のVBScriptで、「コピー元のExcelファイルの指定セルの文字列を、コピー先のExcelファイルにペーストする」という処理を実現しようと思っています。

＜フォルダ構成＞

コピー元フォルダの中にコピー対象のExcelファイルを配置

テンプレートフォルダの中にペーストするExcelファイルを配置。
コピー元フォルダに配置されたExcelファイルの数の分複製される。

実行したところ、以下のようにコピーしたセルが画像のような形でペーストされており、意図した結果でないため困っています。

コピーの仕方が悪いのか、ペーストの仕方が悪いのか、
どなたか原因が分かる方がいらっしゃったらご教示願います。

Option Explicit

'　======================================================================================
' 変数定義
' 
' ======================================================================================

Dim objFSO             ' FileSystemObject
Dim baseFolder         ' 作業フォルダパス
Dim copyFolder         ' コピー元フォルダパス
Dim pasteFolder        ' コピー先フォルダパス
Dim copySheetName      ' コピー元シート名
Dim copyRange          ' コピー元セル範囲

Dim pasteSheetName     ' コピー先シート名

Dim templateFileName   ' テンプレートファイル名
Dim templateFolder     ' テンプレートファイルが配置されたフォルダパス

' ======================================================================================
' パラメータ設定（環境に合わせて定義すること）
' 
' ======================================================================================

copySheetName = "フォーマット" ' コピー元シート名
copyRange = "[B6:E6],[B9:D10],[G7:AJ106]" ' コピー元セル範囲（複数の範囲指定⇒（例）"[A1:A2],[B1,B2]"）

pasteSheetName = "フォーマット" ' コピー先シート名

templateFileName = "template.xlsx"


' ======================================================================================
' EXCELコピー＆ペースト
'
' ======================================================================================
' フォルダパス設定
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
    Dim currentDir
    currentDir = objFSO.getParentFolderName(WScript.ScriptFullName)
    copyFolder = currentDir & "\" & "コピー元"
    pasteFolder = currentDir & "\" & "コピー先"
    templateFolder = currentDir & "\" & "テンプレート"
Else
	WScript.Echo "エラーが発生したため終了します。"
    WScript.Quit
End If

' コピー元セル範囲をリスト化
Dim RangeList
RangeList = Split(copyRange, ",")

'エラー情報をクリアする。
Err.Clear


' フォルダ内（サブフォルダも含む）でループしてコピー元ファイルを取得
ShowSubfolders objFSO.GetFolder(copyFolder)

Dim File
Sub ShowSubFolders(Folder)
    For Each File in Folder.Files 'フォルダ内のファイルを列挙する
        'EXCELファイルか判定
        Dim ext
        ext = objFSO.GetExtensionName(File.Name)

        If ext = "xlsx" Or ext = "xlsm" Then
            ' 変数定義
            Dim copyFilePath, pasteFilePath, templateFilePath, copyExcelObj, pasteExcelObj
            Dim copyFileObj, pasteFileObj, copySheetObj, pasteSheetObj
            
            templateFilePath = templateFolder & "\" & templateFileName
            copyFilePath = copyFolder & "\" & File.Name
            pasteFilePath = pasteFolder & "\" & File.Name
            
            ' コピー元と同じファイル名でコピー先ファイルを生成
            objFSO.CopyFile templateFilePath, pasteFilePath, True
            
            ' コピーエラー発生時は終了する
            If Err.Number <> 0 Then
                Set File = Nothing
                Set objFSO = Nothing
                
                WScript.Echo "テンプレートコピーでエラーが発生したため終了します。"
                WScript.Quit
            End If
            
            ' コピー元ファイルを開く
            Set copyExcelObj = WScript.CreateObject("Excel.Application")
            Set copyFileObj = copyExcelObj.Workbooks.Open(copyFilePath)
            Set copySheetObj = copyFileObj.Worksheets(copySheetName)
            
            
            ' コピー先ファイルを開く
            Set pasteExcelObj = WScript.CreateObject("Excel.Application")
            Set pasteFileObj = pasteExcelObj.Workbooks.Open(pasteFilePath)
            Set pasteSheetObj = pasteFileObj.Worksheets(pasteSheetName)
            
            pasteSheetObj.Activate
            
            ' コピー対象セル範囲を取得（リストで保持）
            Dim RangeVal
            For Each RangeVal in RangeList
                RangeVal = Replace(Replace(RangeVal, "[", ""), "]", "")
                
                copySheetObj.Range(RangeVal).Copy
                
                ' コピー先ファイルにペースト
                'pasteSheetObj.Range("A1").Select
                ' -4104
                pasteSheetObj.Range(RangeVal).PasteSpecial(-4104)
                
            Next
            
            pasteFileObj.Save
            pasteFileObj.Close
            
            copyExcelObj.Quit
            pasteExcelObj.Quit
            
        Else
            WScript.Echo "テンプレートコピーに失敗しました。"
            WScript.Quit
        End If
    Next

    Dim Subfolder
    For Each Subfolder in Folder.SubFolders 'フォルダ内のフォルダを列挙する
        ShowSubFolders Subfolder '再帰呼び出し
    Next
End Sub

WScript.Echo "テストデータコピーが完了しました。"
WScript.Quit

Set copyExcelObj = Nothing
Set copyFileObj = Nothing
Set copySheetObj = Nothing

Set pasteExcelObj = Nothing
Set pasteFileObj = Nothing
Set pasteSheetObj = Nothing

Set File = Nothing
Set objFSO = Nothing

Set Subfolder = Nothing

Answer 1

色々調べてみましたけど原因不明です。
値のみのコピーで良いならPasteSpecial(-4163)とすることで可能です。
ただし、以下の警告が出てしまいます。

貼り付けようとしているデータと選択した領域のサイズと異なります。貼り付けますか？

こちらも理由はわかりませんでした。
G7:AJ106のときのみ出るので、範囲が広いと出るのかもしれません。
こちらの仮対処としては、貼り付け時の範囲を左上のみを指定することで回避できました。

rs = Split(RangeVal, ":")
pasteSheetObj.Range(rs(0)).PasteSpecial(-4163)

Comments

[irohamaru]

わざわざ調べてくださり、ありがとうございます！
根本的な原因は気になりますが、とりあえず回避策が見つかっただけでも感謝です。
ありがとうございました！