'// ブックオープン判定関数
Function IsBookOpened(a_sFilePath) As Boolean
On Error Resume Next

'// 保存済みのブックか判定
Open a_sFilePath For Append As #1
Close #1

If Err.Number > 0 Then
'// 既に開かれている場合
IsBookOpened = True
Else
'// 開かれていない場合
IsBookOpened = False
End If
End Function
 


?V他ブックの内容をコピペする（パターン化する）
 
Function OpenBk(opPath As String) As Variant
Dim ex      As Excel.Application        	'// 処理用Excel
Dim wb      As Workbook                 	' コピーするために開いたブック
Dim sPath   As String                   	'// ブックファイルパス
Dim r       As Range                    	'// 取得対象のセル範囲
Dim sht     As Worksheet                	'// 参照シート
Dim bFlg    As Boolean


OpenBk = False
'// 開くブックを指定（コピーしたいデータが入っている方）
sPath = opPath

'// 既に開かれているか確認
bFlg = IsBookOpened(sPath)

'// 開かれている場合
If bFlg Then
Set ex = New Excel.Application
'// 新規Excelで読み取り専用で開く
Set wb = ex.Workbooks.Open _
(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Else
'// 現ブックで読み取り専用で開く
Set wb = Workbooks.Open _
(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
End If

ThisWorkbook.Activate   'ここでコレを入れないとちゃんとコピペしないから！
 

※このVBA処理を書いているモジュールを含むブックがThisWorkbookになる！

'''　「ここから処理を書く」
'''※ これはやりたい処理を通常通りセル間の処理でかけば良い。



'''　「ここまで処理」

 
'// ブックを閉じる
Call wb.Close
If bFlg = True Then
Call ex.Application.Quit
End If

OpenBk = True
End Function
 

【構文】
Dir ( [PathName] [, Attributes] )
【戻り値】 文字列型 (String)

引数 Attributes に指定可能な定数
vbNormal　　0　　デフォルト
vbDirectory　16 フォルダ
※コピペ使用ではこの２つをよく使う

基本的な使い方はググればたくさんあるので、ここでは割愛する。

 
' フォルダの存在確認
If Dir(strPathName, vbDirectory) = "" Then
 MsgBox "指定のフォルダは存在しません。", vbExclamation, "出走馬フォルダーのPATH設定" 

Exit Function
End If