ここから本文です

複数のエクセルブックを1つのエクセルにまとめたいです。 マクロを使って出来る・...

icw********さん

2017/8/2514:59:25

複数のエクセルブックを1つのエクセルにまとめたいです。
マクロを使って出来る・・・。とのことだったのですが、うまくいきません。

●やりたいこと
DMリストが業種ごとに抽出してあるの

で、200ぐらいのエクセルブックがあり、
それを1つのエクセルにまとめたい。

●状況
それぞれブック1行目には会社名、郵便番号、住所、業種の並びで項目名があります
(※ものによっては項目の名前が抜けていたりしますが、並びは同じです)

●困っていること
下記のコードがかかれたマクロのダウンロードファイルがあったのですが、
実際使ってみると、1つのエクセルに集約されるものの、元のエクセルファイルに記載がある
業種が抜けていたり、入っていないはずのデータ(元データでは消して上書き済みの電話番号)
などが入っていたりします。

●使ったマクロのコード
ここからダウンロードしました
https://rakuzanet.jp/excel-book-sheet-combine.html

コードの中身
'2015/09/18 ver1.1
Sub ExcelbookCombine()
'結合したいファイルがあるフォルダの場所 cドライブなら "C:\test\"
Const Fol As String = "C:\test\"
Dim Fn
Dim NewFile As Workbook
Dim Wb As Workbook
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim R As Range
Set NewFile = Workbooks.Add
Set Ws1 = NewFile.Worksheets(1)
Set R = Ws1.Range("A1")
Fn = Dir(Fol, vbNormal)
Do Until Fn = ""
Set Wb = Workbooks.Open(Fol & Fn)
'ワークシート1をコピーする場合は Wb.Worksheets(1)
'ワークシート2をコピーする場合は Wb.Worksheets(2)
Set Ws2 = Wb.Worksheets(1)
'Aの1行目から8列目までをコピーして結合する
Ws2.Range("A1", Ws2.Cells(Rows.Count, 1).End(xlUp)).Resize(, 8).Copy R
Set R = R.End(xlDown).Offset(1)
Wb.Close
'Debug.Print Fn
Fn = Dir
Loop
Set R = Nothing
Set Ws1 = Nothing: Set Ws2 = Nothing
Set Wb = Nothing: Set NewFile = Nothing
End Sub


※このHPではA列の1~8列目までが集約されるとありますが、何行あっても集約はされてます。
ただ同じD列E列にデータがあるはずの業種が抜けていて、せっかく1つのエクセルデータに集まってもフィルタをかけられず困っています。

閲覧数:
151
回答数:
1
お礼:
100枚

違反報告

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

fro********さん

2017/8/2515:58:09

おそらくコピーした後のA列に空白セルがあった為そこが最終行として判断されたんだと思います。

コピーする範囲が決まっているなら、その範囲も変数化してしまいましょう。
実際のフォルダの場所とコピー範囲はご自分で変更してください。

Sub ExcelbookCombine()
'結合したいファイルがあるフォルダの場所 cドライブなら "C:\test\"
Const Fol As String = "C:\test\" '最後の"\"を忘れずに
Dim Fn
Dim NewFile As Workbook
Dim Wb As Workbook
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim R As Range
Dim Lrow As Long '追加
Dim myRange As Range '追加

Set NewFile = Workbooks.Add
Set Ws1 = NewFile.Worksheets(1)
Set R = Ws1.Range("A1")

Fn = Dir(Fol, vbNormal)

Do Until Fn = ""
Set Wb = Workbooks.Open(Fol & Fn)
'ワークシート1をコピーする場合は Wb.Worksheets(1)
'ワークシート2をコピーする場合は Wb.Worksheets(2)
Set Ws2 = Wb.Worksheets(1)
'Aの1行目からHの10行目までをコピー
Set myRange = Ws2.Range("A1:H10") 'コピーしたいセル範囲を入力
myRange.Copy R '変更
Lrow = R.Row + myRange.Rows.Count '追加
Set R = Ws1.Range("A" & Lrow) '変更
Wb.Close
'Debug.Print Fn
Fn = Dir
Loop
Set R = Nothing: Set myRange = Nothing '変更
Set Ws1 = Nothing: Set Ws2 = Nothing
Set Wb = Nothing: Set NewFile = Nothing
End Sub

  • 質問者

    icw********さん

    2017/8/2808:46:26

    せっかくお返事を頂いたのに遅くなって申し訳ありません。
    コピー範囲なのですが、ブックによって行数がばらばらで3行しかないブックもあれば、200行以上もあるぶっくもあります・・・。

    その場合のコピー範囲はどうしたらよいのでしょうか。
    何から何まですみません・・・。

  • その他の返信を表示

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

  • 取り消す
  • キャンセル

あわせて知りたい

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

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

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

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

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

閉じる

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

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

閉じる