other

vba 複数ブックから一覧にまとめる

'個別の請求書ブックから、一覧にまとめる

Sub データ取り込み()

Application.ScreenUpdating = False

Dim i As Long
Dim cnt As Long
Dim file
Dim filebook
Dim seikyu As Workbook

cnt = Sheets("一覧").Range("A10000").End(xlUp).Row + 1

file = Application.GetOpenFilename(MultiSelect:=True)

If IsArray(file) Then

For Each filebook In file

Workbooks.Open (filebook)

Set seikyu = ActiveWorkbook

For i = 10 To seikyu.Sheets(1).Range("B10000").End(xlUp).Row

Workbooks("請求書.xlsm").Sheets("一覧").Range("A" & cnt).Value _
= seikyu.Sheets(1).Range("B5").Value

Workbooks("請求書.xlsm").Sheets("一覧").Range("B" & cnt).Value _
= seikyu.Sheets(1).Range("B" & i).Value

Workbooks("請求書.xlsm").Sheets("一覧").Range("C" & cnt).Value _
= seikyu.Sheets(1).Range("E" & i).Value

Workbooks("請求書.xlsm").Sheets("一覧").Range("D" & cnt).Value _
= seikyu.Sheets(1).Range("F" & i).Value

cnt = cnt + 1

Next

seikyu.Close

Next

End If

End Sub
Was this helpful?