여러 EXCEL 파일로 통합 복제
4888 단어 vbs
사용법
스크립트 파일과 동일한 레이어에서 소스 복사 및 대상 복사 폴더를 준비합니다.
스크립트 파일을 편집합니다.다음 변수를 편집합니다.
-baseFolder(스크립트 파일 경로)
-copyBaseFile(복제 소스 폴더에 구성된 파일 경로)
-copyBaseSheetName
-copyBaseRange(소스 파일의 복제 객체 셀 범위)
-pasteSheetName
-pasteRange(대상 파일의 붙여넣기 객체 셀 범위 복사)
ExcelCopyPaste.vbs
baseFolder = "C:XXXXXXXX\ExcelCopyPaste"
copyBaseFolder = baseFolder & "\" & "コピー元"
copyDistFolder = baseFolder & "\" & "コピー先"
copyBaseFile = copyBaseFolder & "\" & "XXXXX.xlsx"
copyBaseSheetName = "XXXXX"
copyBaseRange = "A1:A1"
pasteSheetName = "YYYYY"
pasteRange = "A1:A1"
실행
복사된 원본 파일에서 지정한 작업표의 대상 칸 영역을 대상 폴더에 설정된 모든 파일에 붙여넣습니다.
출처
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
Reference
이 문제에 관하여(여러 EXCEL 파일로 통합 복제), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://qiita.com/irohamaru/items/620f970cbb96d5b51826텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념 (Collection and Share based on the CC Protocol.)