複数のEXCELファイルに一括コピペする

複数のEXCELにコピーしていく作業が面倒だったのでスクリプト作りました。

##使い方
![image.png](https://qiita-image-store.s3.amazonaws.com/0/186221/940e54c1-98f8-d7f0-d168-226cd8b10ce5.png)
スクリプトファイルと同じ階層に「コピー元」「コピー先」フォルダを用意します。

スクリプトファイルを編集します。編集するのは以下の変数です。
- baseFolder （スクリプトのファイルパス）
- copyBaseFile （コピー元フォルダに配置されたファイルパス）
- copyBaseSheetName （コピー元ファイルのシート名）
- copyBaseRange （コピー元ファイルのコピー対象セル範囲）
- pasteSheetName（コピー先ファイルのシート名）
- pasteRange （コピー先ファイルのペースト対象セル範囲）

```vbs:ExcelCopyPaste.vbs
baseFolder = "C:XXXXXXXX\ExcelCopyPaste"

copyBaseFolder = baseFolder & "\" & "コピー元"
copyDistFolder = baseFolder & "\" & "コピー先"

copyBaseFile = copyBaseFolder & "\" & "XXXXX.xlsx"
copyBaseSheetName = "XXXXX"
copyBaseRange = "A1:A1"

pasteSheetName = "YYYYY"
pasteRange = "A1:A1"
```

##実行
コピー元ファイルで指定したシートの対象セル範囲を、コピー先フォルダに配置されたファイル全てに対してペーストします。

##ソース
```vbs:ExcelCopyPaste.vbs
Option Explicit

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

Dim objFSO             ' FileSystemObject
Dim baseFolder         ' 作業フォルダパス
Dim copyBaseFolder     ' コピー元フォルダパス
Dim copyDistFolder     ' コピー先フォルダパス
Dim copyBaseFile       ' コピー先ファイル名
Dim copyBaseSheetName  ' コピー元シート名
Dim copyBaseRange      ' コピー元セル範囲

Dim pasteSheetName     ' コピー先シート名
Dim pasteRange

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

baseFolder = "C:XXXXXXXX\ExcelCopyPaste"

copyBaseFolder = baseFolder & "\" & "コピー元"
copyDistFolder = baseFolder & "\" & "コピー先"

copyBaseFile = copyBaseFolder & "\" & "XXXXX.xlsx"
copyBaseSheetName = "XXXXX"
copyBaseRange = "A1:A1"

pasteSheetName = "YYYYY"
pasteRange = "A1:A1"

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

' ======================================================================================
' EXCELコピー＆ペースト
'
' ======================================================================================
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
    ' コピー元からセル範囲を選択し、クリップボードに貼り付ける
    Dim excelObj, copyBaseFileObj, copyBaseSheetObj, distFolderObj
    Set excelObj = WScript.CreateObject("Excel.Application")
    
    If objFSO.FileExists(copyBaseFile) Then
        Set copyBaseFileObj = excelObj.Workbooks.Open(copyBaseFile)
        Set copyBaseSheetObj = copyBaseFileObj.Worksheets(copyBaseSheetName)
    
        copyBaseSheetObj.Range(copyBaseRange).Copy
    
        Set distFolderObj = objFSO.GetFolder(copyDistFolder)
    
        ' コピー先ファイル群の指定箇所に貼り付ける
    
        ' FolderオブジェクトのFilesプロパティからFileオブジェクトを取得
        Dim objFile
        For Each objFile In distFolderObj.Files
            'EXCELファイルか判定
            Dim ext
            ext = objFSO.GetExtensionName(objFile.Name)
        
            If ext = "xlsx" Or ext = "xlsm" Then
                ' WScript.Echo objFile.Name & "にペーストします。"
            
                Dim excelObj2, pasteFilePath, pasteFileObj, pasteSheetObj
                
                Set excelObj2 = WScript.CreateObject("Excel.Application")
            
                pasteFilePath = copyDistFolder & "\" & objFile.Name
            
                Set pasteFileObj = excelObj2.Workbooks.Open(pasteFilePath)
                
                Set pasteSheetObj = pasteFileObj.Worksheets(pasteSheetName)
            
                pasteSheetObj.Activate
                pasteSheetObj.Range(pasteRange).Select
                ' 値のみコピー -4104
                pasteSheetObj.Range(pasteRange).PasteSpecial(-4104)
            
                pasteFileObj.Save
                pasteFileObj.Close
                Set pasteFileObj = Nothing
            
            	excelObj2.Quit
                Set excelObj2 = Nothing
                Set pasteSheetObj = Nothing
                
                ' WScript.Echo objFile.Name & "にペースト完了しました。"
            
            End If
        
        Next
        
        'コピーするセル数が100以上のときに表示されるダイアログを非表示にする
        copyBaseFileObj.Application.CutCopyMode = False
        copyBaseFileObj.Close
        Set copyBaseFileObj = Nothing
        
        excelObj.Quit
        Set excelObj = Nothing
        Set copyBaseSheetObj = Nothing
        Set distFolderObj = Nothing

        WScript.Echo "EXCELシートのコピー＆ペーストが完了しました。"

    Else
        WScript.Echo "コピー元のファイルが存在しないため処理を終了します。"
        WScript.Quit
    End If

    Set objFSO = Nothing

End If
```