Excel VBA - 複数のブックを単一のシートにマージする

Question

複数のExcelブックを1つのシートにマージしようとしています。私は他のWebサイトからコードを見つけ、フォルダを選択し、フォルダ内のすべてのExcelファイルを現在アクティブなブックにマージすることができました。対象ワークブックは、PIDとサービスである2枚のシートで構成されています。以下のコードされています

Option Explicit 
Public strPath As String 
Public Type SELECTINFO 
hOwner As Long 
pidlRoot As Long 
pszDisplayName As String 
lpszTitle As String 
ulFlags As Long 
lpfn As Long 
lParam As Long 
iImage As Long 
End Type 

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long 
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As SELECTINFO) As Long 
Function SelectFolder(Optional Msg) As String 
Dim sInfo As SELECTINFO 
Dim path As String 
Dim r As Long, x As Long, pos As Integer 
sInfo.pidlRoot = 0& 

If IsMissing(Msg) Then 
    sInfo.lpszTitle = "Select your folder." 
Else 
    sInfo.lpszTitle = Msg 
End If 

sInfo.ulFlags = &H1 

x = SHBrowseForFolder(sInfo) 

path = Space$(512) 
r = SHGetPathFromIDList(ByVal x, ByVal path) 
If r Then 
    pos = InStr(path, Chr$(0)) 
    SelectFolder = Left(path, pos - 1) 
Else 
    SelectFolder = "" 
End If 
End Function 

"Merging Part" 
Sub MergeExcels() 
Dim path As String, ThisWB As String, lngFilecounter As Long 
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet 
Dim Filename As String, Wkb As Workbook 
Dim CopyRng As Range, Dest As Range 
Dim RowofCopySheet As Integer 

RowofCopySheet = 1 

ThisWB = ActiveWorkbook.Name 

path = SelectFolder("Select a folder containing Excel files you want to merge") 

Application.EnableEvents = False 
Application.ScreenUpdating = False 

Set shtDest = ActiveWorkbook.Sheets(1) 
Filename = Dir(path & "\*.xls", vbNormal) 
If Len(Filename) = 0 Then Exit Sub 
Do Until Filename = vbNullString 
    If Not Filename = ThisWB Then 
     Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename) 
     Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)) 
     Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1) 
     CopyRng.Copy Dest 
     Wkb.Close False 
    End If 

    Filename = Dir() 
Loop 

Range("A1").Select 

Application.EnableEvents = True 
Application.ScreenUpdating = True 

MsgBox "Files Merged!" 
End Sub 

マイブックには、最初の（PID）をシート1をコピーする必要があり、2番目のアクションは、私が唯一の唯一のシート1（PID）をマージしたコード.HoweverのSheet2（サービス）をコピーする必要があります。私はコードを微調整しようとしましたが、運はありません。以下のパートIを微調整しようとしている：

Set shtDest = ActiveWorkbook.Sheets(1) 
Filename = Dir(path & "\*.xls", vbNormal) 
If Len(Filename) = 0 Then Exit Sub 
Do Until Filename = vbNullString 
    If Not Filename = ThisWB Then 
     Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename) 
     Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)) 
     Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1) 
     CopyRng.Copy Dest 
     Wkb.Close False 
End If 

IがActiveWorkbook.SheetsにActiveWorkbook.Sheets（1）を変更しようとした（2）と設定CopyRng = Wkb.Sheets（1）に設定CopyRng = Wkb.Sheets （2）、運がない。あなたたちが私を助けてくれることを願っています。ありがとう

Answer 1

コードを調整してテストした後、私は方法を見つけることができました。解決策は、 "Wkb.Sheets（2）.Activate"とSet CopyRng = Wkb.Sheets（1）をSet CopyRng = Wkb.Sheets（2）に変更して2枚目のシートをマージするだけです。以下はサンプルコードです。

Set shtDest = ActiveWorkbook.Sheets(1) 
    Filename = Dir(path & "\*.xls", vbNormal) 
    If Len(Filename) = 0 Then Exit Sub 
    Do Until Filename = vbNullString 
    If Not Filename = ThisWB Then 
     Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename) 
     Wkb.Sheets(2).Activate 
     Set CopyRng = Wkb.Sheets(2).Range(Cells(RowofCopySheet, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)) 
     Set Dest = shtDest.Range("A" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row) 
     CopyRng.Copy Dest 
     Wkb.Close False 
    End If