[[20160420172728]]　『特定フォルダ内にある複数ファイルのシートを一つ』（mika）　ページの最後に飛ぶ

『特定フォルダ内にある複数ファイルのシートを一つのファイルにまとめたい』（mika）

いつも参考にさせていただいております。
過去文書も検索しましたが該当の物がありませんでしたので、質問させていただきました。

特定のフォルダに入っている各ブックのシートを、全て新しいブックにコピーしたいのですが、どうしたらいいでしょうか。

＊フォルダには約80個のブックがあります。(ブック名は全て異なります)
＊各ブックの中にはシートが１つだけ存在します。(シート名は全て異なります)
＊この各ブックの各シートを全て１つのファイル（80シートになるよう）にまとめたい

（なおリンク等はありませんが、シート内で完結する数式は入っています。）

こんなことができますでしょうか？
ご教示いただければ幸いです。よろしくお願い致します。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

似たようなコーディングは何度も書いているのですけどねぇ。探すのも面倒なので、新規作成。

 Sub test()
    Const cPATH = "c:\フォルダ名\"
    Dim cFiles As Variant
    Dim cFile As String
    Dim i As Long

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "*.xls*""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        cFile = LCase(Mid(cFiles(i), InStrRev(cFiles(i), "\") + 1))
        If cFile <> LCase(ActiveWorkbook.Name) Then
            With Workbooks.Open(cFiles(i), False, True)
                .Sheets(1).Copy after:=Me.Parent.Sheets(Me.Parent.Sheets.Count)
                .Close False
            End With
        End If
    Next i
 End Sub

試していませんが、数式は元のブックを参照してしまいそうな気がします。値だけコピーする方が良いのでは？
（???） 2016/04/20(水) 18:06

似たようなｺｰﾄﾞから探すことができず申し訳ありません。。

上記ｺｰﾄﾞで試しましたが、エラーになります。。
(Meキーワードの使用が不正です、とでます)

確かに数式ではなく値コピーの方がファイルも軽くなりますし良いですよね。

（mika） 2016/04/20(水) 18:19

 失礼します。

 (???)さんは、シートモジュールに記述する形式でコードをアップされることが多いです。
 このコードを、任意のシートモジュールに記述して実行してみてください。

 また、標準モジュールに記述するなら

 .Sheets(1).Copy after:=Me.Parent.Sheets(Me.Parent.Sheets.Count)

 これを

 .Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

 にかえて試してみてください。

（β） 2016/04/20(水) 19:17

 すでに　(???)さんから、効率の良い DIRコマンドを使った例がアップされていますので参加目的だけで
 わりあいとよく使われる、DIR関数とFSOを使った例です。
 フォルダは、デスクトップ上の　"Test" というフォルダにしてあります。
 (???)さんのコードはマクロブックにシートを取り込んでおられますが、以下のコードでは
 新規ブックとして作成しています。

 Sub Sample1()
    Dim fPath As String
    Dim fName As String
    Dim sh As Worksheet
    Dim nbk As Workbook

    Application.ScreenUpdating = False

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test\"

    fName = Dir(fPath & "*.xlsx")

    Do While fName <> ""
        Set sh = Workbooks.Open(fPath & fName, UpdateLinks:=False, ReadOnly:=True).Sheets(1)
        If nbk Is Nothing Then
            sh.Copy
            Set nbk = ActiveWorkbook
        Else
            sh.Copy after:=nbk.Sheets(nbk.Sheets.Count)
        End If
        sh.Parent.Close False
        fName = Dir()
    Loop

 End Sub

Sub Sample2()

    Dim fso As Object
    Dim file As Object
    Dim fPath As String
    Dim sh As Worksheet
    Dim nbk As Workbook

    Application.ScreenUpdating = False

    fPath = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\Test"
    Set fso = CreateObject("Scripting.FileSystemObject")

    For Each file In fso.GetFolder(fPath).Files
        If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Then
            Set sh = Workbooks.Open(file.Path, UpdateLinks:=False, ReadOnly:=True).Sheets(1)
            If nbk Is Nothing Then
                sh.Copy
                Set nbk = ActiveWorkbook
            Else
                sh.Copy after:=nbk.Sheets(nbk.Sheets.Count)
            End If
            sh.Parent.Close False
        End If
    Next
End Sub

（β） 2016/04/20(水) 20:39

私の書いたマクロは、標準モジュールではなく、シートモジュールのいずれかに貼ってみてください。
そうすると、Meは自分のシートを示します。
（???） 2016/04/21(木) 09:03

コメント返信：

[ 一覧(最新更新順) ]

[[20160420172728]] 『特定フォルダ内にある複数ファイルのシートを一つ』（mika） ページの最後に飛ぶ

[[20160420172728]]　『特定フォルダ内にある複数ファイルのシートを一つ』（mika）　ページの最後に飛ぶ