|
試しに作ってみました。
出力結果を書き込みたいブック(hokkaido_total.xls)に以下のコードを
コピペして実行して下さい。
同じフォルダ内のExcelブックからデータを抽出します。
Private Sub CommandButton1_Click()
Dim ファイル As String
Dim 一覧 As String
Dim Result As Long
'##################################
' 同フォルダ内のExcelファイル検出
'##################################
ファイル = Dir("*.xls")
Do While ファイル <> ""
If ファイル = ThisWorkbook.Name Then ファイル = ""
一覧 = 一覧 & Chr(13) & ファイル
ファイル = Dir()
Loop
Result = MsgBox("以下のファイルが見つかりました。実行しますか?" & Chr(13) & 一覧, 4, "ファイル確認")
If Result = 7 Then
Exit Sub
End If
'########################
' データのコピー
'########################
ファイル = Dir("*.xls")
Do While ファイル <> ""
If ファイル <> ThisWorkbook.Name Then
'ファイルを開く
Workbooks.Open Filename:=ファイル
'セルL2→B列
ThisWorkbook.Worksheets("sheet1").Range("B65536").End(xlUp).Offset(1, 0).Value = _
ActiveWorkbook.Worksheets("sheet1").Range("L2").Value
'セルL3→C列
ThisWorkbook.Worksheets("sheet1").Range("C65536").End(xlUp).Offset(1, 0).Value = _
ActiveWorkbook.Worksheets("sheet1").Range("L3").Value
'セルZ15→D列
ThisWorkbook.Worksheets("sheet1").Range("D65536").End(xlUp).Offset(1, 0).Value = _
ActiveWorkbook.Worksheets("sheet1").Range("Z15").Value
'ファイルを閉じる
ActiveWorkbook.Close
End If
ファイル = Dir()
Loop
ThisWorkbook.Worksheets("sheet1").Range("B1:D1").Delete Shift:=xlUp
End Sub
|
|