■VLOOKUPで抽出
=VLOOKUP(B14,INDIRECT(C$13&$B$12),2,FALSE)
■VBA
Sub MergeExcelFiles()
Dim folderPath As String
Dim fileName As String
Dim wbSource As Workbook
Dim wbDest As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
' フレーム.xlsmのファイルパスを取得
folderPath = ThisWorkbook.Path & "\"
' フォルダ内のExcelファイルを順に処理
fileName = Dir(folderPath & "*.xlsx")
Do While fileName <> ""
' ファイルを開く
'画面更新停止
Application.ScreenUpdating = False
Set wbSource = Workbooks.Open(folderPath & fileName)
' 各シートを取り込む
For Each wsSource In wbSource.Sheets
On Error Resume Next
Set wsDest = ThisWorkbook.Sheets(wsSource.Name)
On Error GoTo 0
' 同名のシート場合のみ追加
If wsSource.Name = Left(fileName, Len(fileName) - 5) Then
' 既存の同名シートを削除
Application.DisplayAlerts = False
ThisWorkbook.Sheets(wsSource.Name).Delete
Application.DisplayAlerts = True
' シートをコピー
wsSource.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next wsSource
' ファイルを閉じる
wbSource.Close SaveChanges:=False
'画面更新再開
Application.ScreenUpdating = True
' 次のファイルを取得
fileName = Dir
Loop
ThisWorkbook.Sheets(1).Select
' 完了メッセージを表示
MsgBox "シートの取り込みが完了しました。"
End Sub
