Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

702 / 76735

←次へ　｜　前へ→


	【81698】一つのフォルダ内にあるエクセルファイルをすべて一つのシートにまとめたい

［名前なし］エク初心者 - 21/3/25(木) 7:19 -


	引用なし

	パスワード

はじめまして、ご覧いただきありがとうございます。

私がやりたいのは
・フォルダを選択するボタンを押すと選択出来る
・その情報が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から取得するのは難しいのかなと思いました。
どう変えたらいいのか、ご教示いただけないでしょうか。
よろしくお願いいたします。

0 hits

▼

【81698】一つのフォルダ内にあるエクセルファイルをすべて一つのシートにまとめたい ［名前なし］エク初心者 21/3/25(木) 7:19