| 
    
     |  | データを最下行に追加するものだと思っていました。(^_^;) たえず2行目なのですね。
 
 Sub Sample3()
 Dim FileName As Variant
 Dim wb As Workbook
 Dim i As Long
 Dim myRow 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")
 
 Rows(2).Insert Shift:=xlDown
 
 For i = 1 To wb.Worksheets.Count
 Select Case Worksheets(i).Name
 Case "Mois"
 .Range("B2").Value = wb.Worksheets(i).Range("A1").Value
 Case "NOS"
 .Range("C2").Value = wb.Worksheets(i).Range("C2").Value
 Case "SOL"
 .Range("D2").Value = wb.Worksheets(i).Range("D4").Value
 End Select
 Next i
 
 wb.Close False
 
 End With
 End Sub
 
 |  |