【Excel】別ブックからシートをコピペするExcelVBA雛形

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

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

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   'ここでコレを入れないとちゃんとコピペしないから！

'''　「ここから処理を書く」
	
'''[出走RH][出走D]をコピペ
'    Dim Gyo1  As Integer                     	'出走RHの最終行
'    Dim Gyo2  As Integer                     	'出走Dの最終行
'    Dim int1 As Integer, int2 As Integer

    Gyo1 = 0
    Gyo2 = 0
    
    For int1 = 1 To 10000
        If Sheets("出走RH").Cells(int1 + 1, 1) = "" Then Exit For
        Gyo1 = int1
    Next int1
    For int1 = 1 To 10000
        If Sheets("出走D").Cells(int1 + 1, 1) = "" Then Exit For
        Gyo2 = int1
    Next int1
   
    '// 各シート「出走RH」取得
    For Each sht In wb.Worksheets
        If sht.Name = "出走RH" Then
            For int1 = 1 To 13
                For int2 = 1 To 14
                    Sheets("出走RH").Cells(Gyo1 + int1 + 1, int2) = _
                    sht.Cells(int1 + 1, int2)
                Next int2
            Next int1
        End If
        If sht.Name = "出走D" Then
            For int1 = 1 To 500
                If sht.Cells(int1 + 1, 1) = "" Then Exit For
                For int2 = 1 To 35
                    Sheets("出走D").Cells(Gyo2 + int1 + 1, int2) = _
                    sht.Cells(int1 + 1, int2)
                Next int2
            Next int1
        End If
    Next
    
    '''出走Dをコピペ

'''　「ここまで処理」
    
    '// ブックを閉じる
    Call wb.Close
    If bFlg = True Then
        Call ex.Application.Quit
    End If
    
    OpenBk = True
End Function
 
'// ブックオープン判定関数
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