| |
はじめまして、ご覧いただきありがとうございます。
私がやりたいのは
・フォルダを選択するボタンを押すと選択出来る
・その情報がA2から差し込まれる
・フォルダ内にある全てのエクセルファイルの1番目のシートのA2からまとめたい
ということです（わかりづらかったらもうしわけありません）。
そこで
Sub folder()
If Application.FileDialog(msoFileDialogFolderPicker).Show = True Then
Range("b2").Value = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Sub
Sub merge()
'シート［merge］を削除
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("merge").Delete
Application.DisplayAlerts = True
'シート［merge］を一番右に追加
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = "merge"
'フォルダの場所を変数に入れる
Dim Folder_path
Folder_path = ThisWorkbook.Worksheets("folder").Range("b2").Value
'結合するブックを変数に入れる
Dim FileType
If Worksheets("folder").Range("b1").Value = "Excel" Then
FileType = "\*.xls*"
Else
FileType = "\*.csv"
End If
Dim MergeWorkbook
MergeWorkbook = Dir(Folder_path & FileType)
'指定したフォルダから、ファイルを探して、開いてコピペ
Do Until MergeWorkbook = ""
Workbooks.Open Filename:=Folder_path & "\" & MergeWorkbook
Dim MergeWorkbook_data '結合するブック内のシートのデータ数
Dim ThisWorkbook_data '結合先のシートのデータ数
Dim i
For i = 1 To Workbooks(MergeWorkbook).Worksheets.Count
MergeWorkbook_data = Workbooks(MergeWorkbook).Worksheets(i).Range("a" & Rows.Count).End(xlUp).Row
ThisWorkbook_data = ThisWorkbook.Worksheets("merge").Range("a" & Rows.Count).End(xlUp).Row
Workbooks(MergeWorkbook).Worksheets(i).Rows("1:" & MergeWorkbook_data).Copy ThisWorkbook.Worksheets("merge").Range("a" & ThisWorkbook_data + 1)
Next
'結合するブックを閉じる
Application.DisplayAlerts = False
Workbooks(MergeWorkbook).Close
Application.DisplayAlerts = True
'次のブックを探しに行く
MergeWorkbook = Dir()
Loop
End Sub
こういうものを見つけたのですが、これだとA2から取得するのは難しいのかなと思いました。
どう変えたらいいのか、ご教示いただけないでしょうか。
よろしくお願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
