標準モジュールコピー for VBA

ブックからブックへのシートコピーは、シートオブジェクトのcopyメソッドで、シート全体（内容データも制御データ）と、そしてシートモジュールまでもが一緒にコピーできます。

では、標準モジュール、クラスモジュール、フォーム、ThisWorkbookは、どうやってコピーするのでしょうか･･･。
これらは、VBProject.VBComponentsオブジェクトのExportメソッドで外に出し、同オブジェクトのImportメソッドで取り込み、コピーをします。
尚、ThisWorkbookに関しては、ソースコードを１行目から最終行まで指定してコピーします。

◆サンプルプログラム

Option Explicit
Sub TestCopyModule()

Dim Book1 As Workbook
Dim Book2 As Workbook

    Set Book1 = ThisWorkbook  '自ブックオブジェクト
    Set Book2 = Workbooks.Add '新規ブックオブジェクト

    If CopyModule(Book1, Book2) = -1 Then
       MsgBox "コピー失敗"
    End If
End Sub

Function CopyModule(ByVal orgBook As Workbook, ByVal cpyBook As Workbook) As Long
'引　数：orgBook コピー元ワークブックオブジェクト
'引　数：cpyBook コピー先ワークブックオブジェクト
'戻り値：成功 コピーしたモジュールの数（ThisWorkbookも含む）
Dim objVBC   As Object
Dim lngCount As Long
Dim strPath  As String
Dim strFile  As String
Dim strCode  As String

On Error GoTo COPY_ERROR

    strPath = orgBook.Path

    For Each objVBC In orgBook.VBProject.VBComponents
        Select Case objVBC.Type
            Case 1 To 3: '1:Module 2:Class 3:Form
                strFile = strPath & "\" & objVBC.Name
                'Export Module
                objVBC.Export Filename:=strFile
                'Import Module
                cpyBook.VBProject.VBComponents.Import Filename:=strFile
                lngCount = lngCount + 1
            Case 100: ' 100:Sheet or ThisWorkbook
                If objVBC.Name = "ThisWorkbook" Then
                    With orgBook.VBProject.VBComponents("ThisWorkbook").CodeModule
                         If .CountOfLines > 0 Then
                            strCode = .Lines(1, .CountOfLines)
                            With cpyBook.VBProject.VBComponents("ThisWorkbook").CodeModule
                                .InsertLines 1, strCode
                            End With
                         End If
                    End With
                    lngCount = lngCount + 1
                End If
        End Select
    Next
    CopyModule = lngCount
    Exit Function

COPY_ERROR:
    MsgBox Err.Description & " " & Err.Number
    CopyModule = -1
End Function