ここから本文です

複数のブックのシートを新規ブックの1シートにまとめたい 特定のフォルダにあ...

nsf********さん

2017/8/616:20:24

複数のブックのシートを新規ブックの1シートにまとめたい

特定のフォルダにある複数のExcelブック(約40ファイル)のデータを、1つのブックにまとめたいと思っています。

・複数のブッ

クのデータはすべて「Sheet1」にはいっています。1行目は項目見出しになっています。
・複数のブックのデータ項目の並びは全て同じで、A列からE列まであります。
・まとめたいのはB列からE列までです。
・また、C列の項目は種別になっていて(例えば:みかん、りんご、ばなな)種別が「みかん」のデータのみをまとめたいのです。
・さらに、データを取り出し、新規ブックにまとめる際、新規ブックのシートのA列は取り込んだブック名をを表示したいです。
マクロで処理したいと考えています。
どなたかお知恵を貸してください。

補足さっそくのご回答ありがとうございます。教えていただいた式を新規のエクセルブックにコピーし、マクロに登録し実行してみました。
ストップすることなくマクロは実行されたようなのですが、集計結果がどこにも反映されたいません。
どこに反映されているのかご教授いただけませんでしょうか。

閲覧数:
151
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

kky********さん

2017/8/617:36:51

集計したいブックに入れるマクロの一例です。
最初の Const fpath As String = "D:\Data\"
ここに複数データがあるフォルダを書いて下さい。
最後に \ を忘れないようにして下さい。

Sub Sample()
Const fpath As String = "D:\Data\"
Dim fname As String
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long
Dim scnt As Integer
Dim j As Long
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
Set sh1 = wb1.Worksheets("Sheet1")
fname = Dir(fpath & "*.xlsx", vbNormal)
Do Until fname = ""
Set wb2 = Workbooks.Open(fpath & fname)
Set sh2 = wb2.Worksheets("Sheet1")
With sh2
For i = 1 To .Cells(Rows.count, "C").End(xlUp).Row
If .Range("C" & i).Value = "みかん" Then
j = j + 1
sh1.Range("A" & j).Value = Left(fname, InStrRev(fname, ".") - 1)
.Range("B" & i & ":E" & i).Copy Destination:=sh1.Range("B" & j)
End If
Next i
End With
wb2.Close
fname = Dir()
Loop
Application.ScreenUpdating = True
End Sub

  • 質問者

    nsf********さん

    2017/8/711:51:55

    さっそくのご回答ありがとうございます。
    教えていただいた式を新規のエクセルブックにコピーし、マクロに登録し実行してみました。
    ストップすることなくマクロは実行されたようなのですが、集計結果がどこにも反映されたいません。
    どこに反映されているのかご教授いただけませんでしょうか。

  • その他の返信を表示

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2017/8/9 12:05:20

こちらの不注意のために何度も返信していただくことになり申し訳ありませんでした。
データは抽出できました。
大変助かりました。ありがとうございました。

ベストアンサー以外の回答

1〜1件/1件中

mit********さん

2017/8/617:29:37

関数式を使っても対応できる内容です。
もっとも面倒なことはC列のデータでみかんのみのデータを抽出したいとのことですからすべてのブックのシート1には作業列を作ることが必要で例えばH2セルには次の式を入力して下方にドラッグコピーします。

=IF(C2="みかん",MAX(H$1:H1)+1,"")

すべてのブックは立ち上げられていることが必要です。
そこで新規ブックのシート1には作業列を設けます。
例えばJ2セルから下方にはすべてのブックのブック名を入力します。
次にK1セルには必ず0を入力したのちにK2セルには次の式を入力して下方にドラッグコピーします。

=IF(J2="","",COUNT(INDIRECT("["&J2&".xls]Sheet1!H:H"))+MAX(K$1:K1))

その後にA2セルには次の式を入力してE2セルまで横にドラッグコピーしたのちに下方にもドラッグコピーすればよいでしょう。

=IF(ROW(A1)>MAX($K:$K),"",IF(COLUMN(A1)=1,INDEX($J:$J,MATCH(ROW(A1)-0.1,$K:$K,1)+1),INDEX(INDIRECT("["&$A2&".xls]Sheet1!A:E"),MATCH(ROW(A1)-INDEX($K:$K,MATCH(ROW(A1)-0.1,$K:$K,1)), INDIRECT("["&$A2&".xls]Sheet1!H:H"),0),COLUMN(A1))))

なお、作業列が目障りでしたらそれらの列を選んで右クリックし「非表示」を選択すればよいでしょう。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる