Sub TEST1()
Dim A
'ファイルパスを指定
A = ThisWorkbook.Path & "\TEST\TEST1【重要】.xlsx"
Workbooks.Open A 'ブックを開く
Dim B
'現在ブックの最終行
Set B = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
With ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
'データ部分を取得
.Resize(.Rows.Count - 1).Offset(1, 0).Copy B.Offset(1, 1)
'ブック名を取得
B.Resize(.Rows.Count - 1).Offset(1, 0) = ActiveWorkbook.Name
End With
ActiveWorkbook.Close False 'ブックを閉じる
End Sub
VBAコードを実行すると、1つの別ブックから値を取得できます。
1つのブックの値を取得
1つの別ブックから値を取得できました。
Dir関数を使って1つのブックの値を取得
次は、Dir関数を使って1つのブックの値を取得してみます。
Sub TEST2()
Dim A
'フォルダ内の1つのブック名を取得
A = Dir(ThisWorkbook.Path & "\TEST\*")
'ブックを開く
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A
Dim B
'現在ブックの最終行
Set B = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
With ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
'データ部分を取得
.Resize(.Rows.Count - 1).Offset(1, 0).Copy B.Offset(1, 1)
'ブック名を取得
B.Resize(.Rows.Count - 1).Offset(1, 0) = ActiveWorkbook.Name
End With
ActiveWorkbook.Close False 'ブックを閉じる
End Sub
実行すると、Dir関数でブック名を取得して、1つのブックから値を取得できます。
Dir関数を使って、1つのブックの値を取得
Dir関数でブック名を取得して、1つのブックから値を取得できました。
Dir関数を使って複数ブックをループして値を取得
次は、Dir関数を使って複数ブックをループして値を取得してみます。
Sub TEST3()
Dim A
'フォルダ内の1つのブック名を取得
A = Dir(ThisWorkbook.Path & "\TEST\*")
Do While A <> ""
'ブックを開く
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A
Dim B
'現在ブックの最終行
Set B = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
With ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
'データ部分を取得
.Resize(.Rows.Count - 1).Offset(1, 0).Copy B.Offset(1, 1)
'ブック名を取得
B.Resize(.Rows.Count - 1).Offset(1, 0) = ActiveWorkbook.Name
End With
ActiveWorkbook.Close False 'ブックを閉じる
A = Dir() '次のブック名を取得
Loop
End Sub
実行すると、Dir関数をループして、フォルダ内のすべてのブックから値を取得できます。
すべてのブックの値を取得
Dir関数をループして、フォルダ内のすべてのブックから値を取得できました。
条件を指定して複数ブックの値を取得
条件を指定して複数ブックの値を取得してみます。
「InStr」で、ブック名の条件を指定するのがポイントになります。
Sub TEST4()
Dim A
'フォルダ内の1つのブック名を取得
A = Dir(ThisWorkbook.Path & "\TEST\*")
Do While A <> ""
'条件を指定
If InStr(A, "【重要】") > 0 Then
'ブックを開く
Workbooks.Open ThisWorkbook.Path & "\TEST\" & A
Dim B
'現在ブックの最終行
Set B = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)
With ActiveWorkbook.Sheets(1).Range("A1").CurrentRegion
'データ部分を取得
.Resize(.Rows.Count - 1).Offset(1, 0).Copy B.Offset(1, 1)
'ブック名を取得
B.Resize(.Rows.Count - 1).Offset(1, 0) = ActiveWorkbook.Name
End With
ActiveWorkbook.Close False 'ブックを閉じる
End If
A = Dir() '次のブック名を取得
Loop
End Sub
