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

Excel
スポンサーリンク

2つのブックを開いて、Access投入用に1つのブックに纏める

①今VBAを書いているExcelブックが親になる。

②コピペしたい別のブックを読み取り専用で開く。

③コピペしたいシートまたはセル値をコピペする。

プログラムというのは、基本的に動きを理解しないと使えないか?というと既に出来上がっているモノは既に動作確認が取れている場合がほとんでなので、案外そのまま使える。今回のように2つ以上のブックを開いて1つのブックに纏めるというのは、自分でコツコツ組み立てるよりも既に動いている自作関数やモジュールを組み合わせて、パターン化しておくと次回のプログラミングの時間短縮になる。

2つのブックを開いて、Access投入用に1つのブックに纏めておくなんてことは、これからもExcelVBAを使う場合、あらゆる場面で役に立つと思うよ♡

① 今VBAを書いているExcelブックが親になる

ThisWorkbook.Activate

この一文でシート間でのコピペ同様に処理ができる。初めはパターン例文そのままコピペして動作確認さえすれば良い。たくさんプログラムを組めばそのうち内容は理解できる。パターン例文は私が毎週JRAホームページから出走表とレース結果をAccess投入用に日付別のExcelファイルからデータをコピペしデータベースに投入しているものを参考に載せている。

②コピペしたい別のブックを読み取り専用で開く

ブックOpen判定

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

編集後記

ThisWorkbook.Activate

これを文法的に解説しているブログはたまにあるが、具体的な使い方が全くないので、自分で使用して成功するまで、あまり理解しにくい。

今、ExcelVBAで動かしているブックが親「ThisWorkbook.Activate」

他のブックを開いて「ThisWorkbook.Activate」にデータを収集する。

といった使い方をすれば、簡単に誰でも理解できるExcelVBAサンプルが一つ作れる。

※上記サンプルは2つのブックの同じシート名2つのシートから親の同じ名前のシートが入ったブックにデータをコピペして一つのブックにデータを格納している例だ。

動きを理解してから、

  • .Activateメソッド
  • Activateイベント
  • Activeプロパティ各種

「ExcelVBA逆引き」で引いて理解した方が、簡単に使える言語になる。

つまり本に載っている「Activeプロパティ」「Activateメソッド」よりも実は、

「ThisWorkbook」の方が、ExcelVBAで2つ以上のブックを扱う上で一番重要な言語になるがコレを巻末の検索に入れている解説本はほとんどない!「Active」を入口にすると命令の幅が広すぎて、調べたがゆえに、逆に正確にブックを指定できずにエラーが多重化して迷宮化する。

それでは、またね~~(^^♪

タイトルとURLをコピーしました