[[20120509211114]]　『複数ファイルのシートをCSV形式で保存』（えま）　ページの最後に飛ぶ

『複数ファイルのシートをCSV形式で保存』（えま）
いつもお世話になっています。

現在、
1.一つのファイルの偶数シート(10枚）のデータにフィルタをかけ、
コピーし、新しいファイル10枚それぞれに、値の貼り付けする。
2．保存先のフォルダを"C:\"に変更し、
1．で作成した10枚の新しいファイルそれぞれを"C:\＆セルA1の名前＆今日の日付＆.@@@" CSV形式で保存する
というマクロを作っています。
このマクロを一つのフォルダの中の複数のファイルに対して行いたいのですが、
2点、行き詰っています。

・上記の2．10枚の新しいファイルそれぞれの保存の仕方がわかりません。
下のマクロを実行すると、10枚の新しいファイルができ、保存できるのは
アクティブワークブックのみです。（そう書いたからなのですが…)

・複数のファイルに対して行う方法がわかりません。
複数のファイルのデータを一つにまとめる方法はMookさんに教えていただいたの
ですが、一つのファイルではなく、それぞれのファイルに保存するところで
躓いています。

ベースはMookさんに教えていただいたものです。
[[20120430221755]]　

 Sub CSVファイル保存()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim wｓ As Worksheet

    Dim i As Long
    For i = 2 To wb.Worksheets.Count Step 2
        Set wｓ = wb.Worksheets(i)
        With wｓ
        .Range("O4").AutoFilter Field:=15, Criteria1:="3"
        .Range("B4:Q39").SpecialCells(xlCellTypeVisible).Copy
        Workbooks.Add
        Selection.PasteSpecial Paste:=xlValues
        Application.CutCopyMode = False
        End With
　　Next
    wb.Close False

    ChDir "C:\"
        If Dir$("C:\@@@", vbDirectory) = vbNullString Then
        MkDir "C:\@@@"
        End If

    ActiveWorkbook.SaveAs Filename:="C:\QAP\" & Range("A1") & "_" & Format(Now, "yyyymmdd") & ".***", FileFormat:=xlCSV, _
        CreateBackup:=False
    ActiveWindow.Close False

 End Sub

どうぞ、よろしくお願いします。

Excel2007
WindowsXP

 質問で提示されている現在のマクロの流れは理解できているでしょうか。
 　ループ処理が何をしているか
 　ワークブックを作る
 　名前を付けて保存する
 を理解すれば、どこが問題かがわかると思います。

    For i = 2 To wb.Worksheets.Count Step 2
        Set wｓ = wb.Worksheets(i)
        With wｓ
        .Range("O4").AutoFilter Field:=15, Criteria1:="3"
        .Range("B4:Q39").SpecialCells(xlCellTypeVisible).Copy
        Workbooks.Add  '★新規ブックの作成
        Selection.PasteSpecial Paste:=xlValues
        Application.CutCopyMode = False
　　　　　　' ★のブックをここで保存が必要
　　　　　　' ★のブックを閉じる処理もここでやった方がよい
        End With
　　Next
    wb.Close False  '// 処理をしているマクロのブックを閉じたい？ 閉じたら以降の処理がされないのでは？

 フォルダに関しては、 以下は先頭の処理をFor文の前でやっておけばよいと思います。
        If Dir$("C:\@@@", vbDirectory) = vbNullString Then
        MkDir "C:\@@@"
        End If

 ファイル保存は下の処理を、★の部分に書けばよいように見えます。
    ActiveWorkbook.SaveAs Filename:="C:\QAP\" & Range("A1") & "_" & Format(Now, "yyyymmdd") & ".***", FileFormat:=xlCSV, _
        CreateBackup:=False
    ActiveWindow.Close False

 ここの Range がシートやブックの指定が無いので、そこだけ意図したものが使われる
 よう、 確認した方がよいと思います。

 フォルダの中やシートを見ながらステップ実行してみれば、書いたコードが期待通りに
 動いているか確認できるでしょう。
 (Mook)

Mookさん、ありがとうございます。

上に書いた一つ一つの処理は理解して書いたつもりだったのですが、

wb.Close False '// 処理をしているマクロのブックを閉じたい？閉じたら以降の処理がされないのでは？

自分でもなぜここに入れたのか…
書いている間は確信を持っていたはずで、End Subまで来たときは、よくやった！
と自分で褒めていたのですが。（しょんぼり）

Mookさんのアドバイスに従って、以下のように書き換えました。
一つのファイルの複数のシートをCSV形式のファイルに変更し、
該当のフォルダに保存することができました。

これを一つのフォルダ内の複数のファイルに対して実行したいのです。
自分なりにフォルダ操作についてもいろいろ調べたのですが、結局Mookさんに教えていただいた
「まとめシートの作成」がわかりやすく、1行ごとに理解した上でアレンジしたかったのですが、

まとめシートを1枚作る
Workbooks.Add '★新規ブックの作成

この違いをどうすればいいのかわかりませんでした。
飲み込みが遅くて申し訳ないのですが、
フォルダの中の複数ファイルに対して実行するのにはどうすればいいのか教えていただけないでしょうか。
よろしくお願いします。

（えま）

Sub CSVファイル保存()

    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim ws As Worksheet

    ChDir "C:\"
        If Dir$("C:\@@@", vbDirectory) = vbNullString Then
        MkDir "C:\@@@"
        End If

    Dim i As Long
    For i = 2 To wb.Worksheets.Count Step 2
        Set ws = wb.Worksheets(i)
        With ws
        .Range("O4").AutoFilter Field:=15, Criteria1:="3"
        .Range("B4:Q39").SpecialCells(xlCellTypeVisible).Copy
        Workbooks.Add
        Selection.PasteSpecial Paste:=xlValues
        Application.CutCopyMode = False
        ActiveWorkbook.SaveAs Filename:="C:\@@@\" & Range("A1") & "_" & Format(Now, "yyyymmdd") & ".***", FileFormat:=xlCSV, _
        CreateBackup:=False
        ActiveWindow.Close False
    End With
    Next
    wb.Close False
 End Sub

 上のコードで一つのファイルに関しては処理できていると思いますが、問題はありますか？

 ただ、上のコードはマクロを実行したファイルのシートを処理するようにしていますが、
 複数ファイルを処理するのであれば、マクロを実行するファイルではファイルを指定して、
 指定したファイルを処理するように作りかえないと複数ファイルの処理はできません。
 一応サンプルです。
 (Mook)

 Sub 複数ファイル処理()
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    If Dir$("C:\@@@", vbDirectory) = vbNullString Then  '★ ここに移動
        MkDir "C:\@@@"
    End If

    For Each file In fso.GetFolder( "処理したい EXCEL ファイルがあるパス" ).Files
        CSVファイル保存 file.Path
    Next
 End Sub

 Sub CSVファイル保存( filePath ) '★ ここを変更
    Dim wb As Workbook
    Set wb = Workbooks.Open( filePath )  '★ ここを変更
    Dim ws As Worksheet

    Dim i As Long
    For i = 2 To wb.Worksheets.Count Step 2
        Set ws = wb.Worksheets(i)
        With ws
        .Range("O4").AutoFilter Field:=15, Criteria1:="3"
        .Range("B4:Q39").SpecialCells(xlCellTypeVisible).Copy
        Workbooks.Add
        Selection.PasteSpecial Paste:=xlValues
        Application.CutCopyMode = False
        ActiveWorkbook.SaveAs Filename:="C:\@@@\" & Range("A1") & "_" & Format(Now, "yyyymmdd") & ".***", FileFormat:=xlCSV, _
        CreateBackup:=False
        ActiveWindow.Close False
    End With
    Next
    wb.Close False
 End Sub

Mookさん、できました！

というか、途中まで指定のフォルダに指定の形式でできるのですが、30ファイルぐらいの
ところで止まってしまいます。B4に参照式が入っているからかと、
全てのセルを値の貼り付けにしてからオートフィルタ以降の処理をしたのですが、
やっぱり30ファイルあたりで止まります。
今からデバックトレースをやってみます。

（えま）

Mookさん、完成しました。
上の「30ファイルあたりで止まる」原因は、
いくつかのファイルの末尾に空のシートがあったことが原因のようでした。
データの入っていないシートを削除し、マクロを実行すると最後まで動きました。
いくつかCSVファイルをチェックしたところ、正しいデータが並んでいたので
間違いないと思います。

マクロを知らないまま今後も手作業を続けていたらと思うと、ちょっと怖いです。
まだ他にも手作業を繰り返す、という内容の業務がいくつかあり、
その作業にもマクロを取り入れようと思います。

Mookさんには本当にお世話になりました。
本当に本当にありがとうございました。
まだまだ基礎がおぼつかないので勉強を続けていくつもりです。
今後とも、どうぞよろしくお願いします。
（えま）

 無事に、解決できたようでよかったです。
 問題をご自身の力で解決できたのが、何よりも良かったと思います。
 本にもネットにも、参考になる例がたくさんあると思いますので、少しずつ身に付けて
 いろいろなやり方を覚えれば、きっともっとマクロが楽しくなると思います。
 頑張ってください。
 (Mook)

コメント返信：

[ 一覧(最新更新順) ]

[[20120509211114]] 『複数ファイルのシートをCSV形式で保存』（えま） ページの最後に飛ぶ

[[20120509211114]]　『複数ファイルのシートをCSV形式で保存』（えま）　ページの最後に飛ぶ