| 
    
     |  | ▼ぺろ さん: 
 Sub test()
 Dim fdg As FileDialog, p As String
 Dim wsDB As Worksheet, k As String, fn As String
 Dim ws As Worksheet
 
 Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
 If Not fdg.Show Then Exit Sub
 p = fdg.SelectedItems(1) & "\"
 
 Set wsDB = ThisWorkbook.Worksheets("DB")
 k = wsDB.Range("B2").Value
 
 fn = Dir(p & "*" & k & "*.xlsm")
 Do While fn <> ""
 Set ws = Workbooks.Open(p & fn).Worksheets("請求書")
 ws.Range("A18:E38").Copy
 wsDB.Range("B" & Rows.Count).End(xlUp).Offset(1, -1) _
 .PasteSpecial xlPasteValues
 ws.Parent.Close False
 fn = Dir()
 Loop
 
 End Sub
 
 |  |