| 
    
     |  | できますよ。 
 まずファイル選択ダイアログの定番は、
 GetOpenFilename メソッド
 です。
 
 動作未確認の走り書きですが。
 
 
 Sub sample()
 Dim FileName As Variant
 Dim wb As Workbook
 Dim i As Long
 
 FileName = Application.GetOpenFilename("Excelファイル (*.xls), *.xls")
 
 If FileName = False Then
 MsgBox "キャンセルされました"
 Exit Sub
 End If
 
 Set wb = Workbooks.Open(FileName)
 
 
 With ThisWorkbook.Worksheets("sheetDB")
 
 For i = 1 To wb.Worksheets.Count
 Select Case Worksheets(i).Name
 Case "Sheet1"
 .Range("B65536").End(xlUp).Offset(1).Value = wb.Worksheets(i).Range("A1").Value
 Case "Sheet2"
 .Range("C65536").End(xlUp).Offset(1).Value = wb.Worksheets(i).Range("C2").Value
 Case "Sheet3"
 .Range("D65536").End(xlUp).Offset(1).Value = wb.Worksheets(i).Range("D4").Value
 End Select
 Next i
 
 wb.Close False
 
 End With
 End Sub
 
 
 |  |