ゆっくり開発

思いついた便利コードを気ままにアップしていきます。公開しているソースコードはすべてMITライセンスです。

【VBA】別ファイルのシートコピー

Function 別ブックのシート取込( _
                          ByRef 対象ファイルのパス As String _
                        , ByRef 対象シート一覧 As Variant _
                        , Optional ByRef シートを表示する As Variant = xlSheetVisible _
                        )
    
    On Error GoTo ■エラー処理
    
    Dim ファイルシステム As Object
    Dim シート As Worksheet
    Dim 対象シート名 As Variant
    Dim 対象ブック As Workbook
    Dim 取込成功 As Boolean
    Dim 処理用対象シート一覧() As Variant
    Dim 存在しないシート一覧 As String
    
    If ブックを開く(対象ファイルのパス, 表示で開く:=False, 読み取り専用:=True, 読み取り推奨メッセージを非表示にする:=True) = False Then GoTo ■終了処理
    
    Set ファイルシステム = CreateObject("Scripting.FileSystemObject")
    Set 対象ブック = Workbooks(ファイルシステム.GetFileName(対象ファイルのパス))
    
    '対象シート一覧が単一(配列でない)場合配列に変換する
    If IsArray(対象シート一覧) Then
        処理用対象シート一覧 = 対象シート一覧
    Else
        ReDim 処理用対象シート一覧(0)
        処理用対象シート一覧(0) = 対象シート一覧
    End If
    
    For Each 対象シート名 In 処理用対象シート一覧
        取込成功 = False
        For Each シート In 対象ブック.Worksheets
            If シート.Name = 対象シート名 Then
                シート.Copy after:=集計シート
                このブック.Worksheets(対象シート名).Visible = シートを表示する
                取込成功 = True
                Exit For
            End If
        Next
        If 取込成功 = False Then Exit For
    Next
    
    If 取込成功 Then
        Debug.Print "●別ブックのシート取込の成功●"
    Else
        Debug.Print "▲別ブックのシート取込の失敗▲"
    End If
    別ブックのシート取込 = 取込成功
    GoTo ■終了処理
    
■エラー処理:
    Debug.Print "▲別ブックのシート取込のエラー▲" & vbCrLf & vbTab & Err.Number & vbTab & Err.Description
    
■終了処理:
    Call ブックを閉じる(対象ブック.Name, False)

End Function