[[20100220200243]]　『複数のブックを統合したいのですが』（hana）　ページの最後に飛ぶ

『複数のブックを統合したいのですが』（hana）

 特定のフォルダにある複数のExcelブック（50コ程度）のデータ行を、１つのシートにまと
 めたいと思っています。複数のExcelブックも、まとめたいブックも、同じ項目の並びに
 なっています。

 ・複数のブックは、すべて5行目からデータ行となっており、行数はばらばらです。
 ・この複数のブックは、すべて同じ項目の並びになっており、A列からBB列までがデータ列
   となっています。
 ・上記を、新しいブックの１つのシートとしてデータを取得したいです。この新しいブッ
   クのシートも、5行目からをデータとして、A～BBまでの項目となっています。

 ネット上で公開されているマクロを参考にしたかったのですが、なかなかぴったりのもの
 がなく、困っています。マクロの初心者なので、詳しい方のお知恵をお借りしたいです。
 よろしくお願いいたします。
 すみません、書き漏らしがありました。取り込みたい複数のブックには、複数のシートが
 あるのですが、取り込みたいのは、「入力シート」というシート名のデータのみになりま 
 す。

 よろしくお願いいたします。（hana）

 まったく自分の目的と同じというものはなくとも、少し変更すればよいという
 ものはたくさんあると思いますよ。
 EXCEL の学校でも、同様の質問に何度も回答した気がしますので。

 とはいえ、過去の回答を探すのはやっぱり面倒なのでｗ、書いてみました。
 (今日の別の質問の回答を再利用ですが)
 Sub gatherEXCELs()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim dstWS As Worksheet
    Set dstWS = Workbooks.Add().Worksheets(1)

    Dim dstRow As Long
    Dim lastRow As Long
    dstRow = 1
    Dim xlFile As Object
    For Each xlFile In fso.GetFolder("D:\DataFolder").Files '★  実際のパスに修正
        If LCase(fso.GetExtensionName(xlFile.Path)) = "xls" Then
            With Workbooks.Open(xlFile.Path)
                lastRow = .Worksheets("入力シート").Range("A" & Rows.Count).End(xlUp).Row
                If lastRow >= 5 Then
                    .Worksheets("入力シート").Range("A5").Resize(lastRow - 4, 54).Copy _
                        Destination:=dstWS.Range("A" & dstRow).Resize(lastRow - 4, 54)
                    dstRow = dstWS.Range("A" & Rows.Count).End(xlUp).Row + 1
                End If
               .Close
            End With
        End If
    Next
 End Sub
 (Mook)

 コードより上の部分は、Mookさんに同じく。（笑）

 勝手に、ブック名も付ける事にしてみました。
 動かなかったらスミマセン。。。

 '------
Sub ブックを統合02()
    Dim seDir As String, myDir As String, myFileName As String
    Dim wb As Workbook, ws As Worksheet
    Dim mxRow As Long, myRow As Long
    With ActiveSheet
        If MsgBox("処理を開始します。現在のシートのデータは削除されます。", _
                    vbOKCancel + vbExclamation) = vbCancel Then
            Exit Sub
        End If
        With Application.FileDialog(msoFileDialogFolderPicker)
            If .Show = True Then
                seDir = .SelectedItems(1)
            End If
        End With
        If seDir = "" Then
            MsgBox "処理を中止します。"
            Exit Sub
        End If
        .Range("4:" & Rows.Count).Clear
    'Application.ScreenUpdating = False
            myDir = seDir & "\"
            myFileName = Dir(myDir & "*.xls")
            Do While myFileName <> ""
                 Set wb = Workbooks.Open(myDir & myFileName)
                 Set ws = wb.Sheets("入力シート")
                    mxRow = ws.Range("A" & Rows.Count).End(xlUp).Row
                    If mxRow > 4 Then
                        If myRow = 0 Then
                            .Range("A4").Value = "ブック名"
                            ws.Range("A4:BB4").Copy .Range("B4")
                        End If
                        .Range("A" & myRow + 5).Resize(mxRow - 4, 1).Value = Mid(myFileName, 1, Len(myFileName) - 4)
                        ws.Range("A5:BB" & mxRow).Copy .Range("B" & myRow + 5)
                        myRow = myRow + mxRow - 4
                    End If
                    wb.Close False
                myFileName = Dir
            Loop
        .Range("B4:B" & mxRow).Copy
        .Range("A4").PasteSpecial Paste:=xlPasteFormats
        .Range("A1").Select
        Application.CutCopyMode = False
    'Application.ScreenUpdating = True
    End With
End Sub
 '------

 (HANA)

Mookさん、ありがとうございました！
早速試したところ、ほぼ欲しい形にデータをまとめられました。
教えていただいたものは、まったく新しいブックを作ってコピーするようなので、コピーしたいブックからこのマクロを使えるように、頑張ってみたいと思います。
大変助かりました。ありがとうございました。

今日、同じ質問があったのですね。全文検索のキーワードがダメだったようです・・。すみません。（hana）

HANAさん、ありがとうございます！！！
取りまとめしたいブックから実行することができて、しかももとデータのフォルダを都度選べるなんて！
やりかたっかこと以上の回答をいただけて、すごく嬉しいです！
とてもとても助かりました。ありがとうございました。（hana）

 試してもらった後なんですが
 A列（ブック名を入れた所）に
 B列（元のファイルのA列）の書式を
 コピーする様に変更しました。
   セルの結合がされてないことを祈って。。。

 コードは直接↑に貼り付けます。
 マクロ名を ブックを統合 → ブックを統合01 にしました。

 (HANA)

HANAさん、ありがとうございました。
でも、上手く書式をもって来れません・・（セル幅や高さなど）。セル結合などはしていませんが、実はA列のブック名は特に必要でなかったため、ここを編集してしまっていたことが原因でしょうか。フォントサイズやハイパーリンクなどは、更新前のマクロでも、もって来れていました。（hana）

 セル幅や高さ等はコピーされません。
 罫線やフォント・背景色がコピーされると思いますが。。。

 　なんだか、誤解がある様に思うのでもう少し詳しく書いておきます。
 　元のブックからコピーして来た部分は元のブックの書式がそのままついていきます。
 　A列にブック名が入るようになっていますが、この列は書式が無いので
 　この列にだけ、B列から書式をコピーする処理を加えました。

 ＞A列のブック名は特に必要でなかったため
 ってことなら、消してもらっておけば良いと思います。

 ご丁寧に連絡いただきありがとうございます。

 なお、値だけの転記で良い場合は　こちらが元にしたコードなので
 （↓では、値だけの転記をしています。）ご参考に。
[[20100217151248]]　『別ファイルから特定の項目にかかった時間を日毎に』（湯）

 ちなみに、この掲示板ですが
_←この部分に半角スペースを入れると
 改行がそのまま表示されるようになります。

 (HANA)

 HANAさん、ありがとうございました。
 すみません、誤解していました。
 実行後の違いがわからなかったので？と思い質問してしまいましたが、
 結合後のB列の書式をA列に反映させる、ということだったのですね。理解しました。

 今回、切羽詰ってここに質問させて貰いましたが、今後は少しずづ勉強していきます。
 お世話になりました！ありがとうございました。
 掲示板の改行も、キチンと付けず失礼しました。（hana）

 済みません、ブックを統合01 に間違いが有ったので
 ブックを統合02に変更しました。。。

 (HANA)

コメント返信：

[ 一覧(最新更新順) ]

[[20100220200243]] 『複数のブックを統合したいのですが』（hana） ページの最後に飛ぶ

[[20100220200243]]　『複数のブックを統合したいのですが』（hana）　ページの最後に飛ぶ