CopySheetsFromFolders

Sub CopySheetsFromFolders()
Dim sourceFolder As String
Dim targetWorkbook As Workbook
Dim sourceWorkbook As Workbook

' Bsukei.xlsmのパスを取得
'targetWorkbookPath = ThisWorkbook.Path

'画面更新停止、警告画面停止
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' 既存の同名シートを削除
ThisWorkbook.Sheets("100").Delete
ThisWorkbook.Sheets("200").Delete
ThisWorkbook.Sheets("300").Delete

' 100フォルダーからシートをコピー
sourceFolder = ThisWorkbook.Path & "\100"
Set sourceWorkbook = Workbooks.Open(sourceFolder & "\100Ksukei.xlsm")
sourceWorkbook.Sheets("100").Copy After:=ThisWorkbook.Sheets(1)
sourceWorkbook.Close SaveChanges:=False

' 200フォルダーからシートをコピー
sourceFolder = ThisWorkbook.Path & "\200"
Set sourceWorkbook = Workbooks.Open(sourceFolder & "\200Ksukei.xlsm")
sourceWorkbook.Sheets("200").Copy After:=ThisWorkbook.Sheets(1)
sourceWorkbook.Close SaveChanges:=False

' 300フォルダーからシートをコピー
sourceFolder = ThisWorkbook.Path & "\300"
Set sourceWorkbook = Workbooks.Open(sourceFolder & "\300Ksukei.xlsm")
sourceWorkbook.Sheets("300").Copy After:=ThisWorkbook.Sheets(1)
sourceWorkbook.Close SaveChanges:=False

'画面更新再開
Application.ScreenUpdating = True

' メッセージを表示
MsgBox "シート取り込み完了"
End Sub