特定のフォルダ内にある全てのExcelを転記用Excelの雛形に転記し、それぞれ名前をつけて保存したいです

Question

Do While LoopとFor Nextの組み合わせのループ処理の不具合です。

マクロで、フォルダ①内にあるExcelファイル（数千個）の必要項目(ファイルによってどの行までデータがあるか異なる)をExcelファイル②(雛形)へ転記し、名前をつけてコピーを保存。その後Excelファイル②のデータをクリ
アし、次のフォルダ①内のExcelファイルの必要項目を転記、、、というループ処理をマクロで組んでいるのですが、名前をつけて保存する部分がうまく行きません。
はじめの５個くらいのファイルが「計算シート_.xls」となってしまい、該当のセル(F7)からファイル名を引用せずコピーして保存してしまいます。
その結果、最初の何個が保存先で上書き保存されてしまい、ファイルがうまく作れません。

間違っている箇所がわからないため、正しく動くにはどうすればいいか教えてください。。。

Sub tenki()

Dim folder As String
Dim file As String
Dim book As Workbook
Dim i As Integer

With Application.FileDialog(msoFileDialogFolderPicker)

If .Show = True Then
folder = .SelectedItems(1)

End If
End With

file = Dir(folder &"*.xls")

Do While file <>""
Set book = Workbooks.Open(folder &""&file)

ThisWorkbook.Worksheets("sheet1").Range("F7").Value = book.Worksheets("sheet1").Range("F7").Value

ThisWorkbook.Worksheets("sheet1").Range("G7").Value = book.Worksheets("sheet1").Range("G7").Value

For i = 13 To Cells(Rows.Count, 1).End(xlUp).Row

ThisWorkbook.Worksheets("sheet1").Range("F"&CStr(i)).Value = book.Worksheets("sheet1").Range("F"&CStr(i)).Value

ThisWorkbook.Worksheets("sheet1").Range("G"&CStr(i)).Value = book.Worksheets("sheet1").Range("G"&CStr(i)).Value

ThisWorkbook.Worksheets("sheet1").Range("H"&CStr(i)).Value = book.Worksheets("sheet1").Range("H"&CStr(i)).Value

Next

Dim Filename As String

Filename = "C:\保存先フォルダ\計算シート_"&Format(Range("F7")) &".xls"ThisWorkbook.SaveCopyAs Filename
Application.DisplayAlerts = False

file = Dir()

book.Close SaveChanges:=False
Application.DisplayAlerts = False

ThisWorkbook.Worksheets("sheet1").Range("F7").ClearContents
ThisWorkbook.Worksheets("sheet1").Range("G7").ClearContents
ThisWorkbook.Worksheets("sheet1").Range("F13:H200").ClearContents

Loop

End Sub

Comments

[cleaner]

該当セルにはちゃんとデータは入っていますか？

[mkmigmyuch]

コメントいただきありがとうございます。
該当セルは転記マクロで転記された値が入りますが、計算シート_.xlsという名前で保存されてしまったExcelを開くと、転記は出来ているので、データは入っています。

[cleaner]

ファイル名を付けるときにFormat関数を使用しているのはなぜですか？
Format関数ではなく、セルの値をそのまま使うとどうなりますか？
もしかしたらFormat関数で空白文字列が返されてるかもしれません。
デバッグで確認してみてはどうでしょうか？

[mkmigmyuch]

勉強しながら作成しているため、付け焼き刃な言語になっているかもしれません。。。
F7のセルに転記される値はファイル毎に異なり、セルの値をファイル名として表示させる方法が分からなかったため、インターネットで検索し、Format関数を使うとあったので使用いたしました。
セルの値をそのまま使うとは、どのような記載をすれば出来るのでしょうか？
うろ覚えで申し訳ないですが、Range("F7")といれても、そのままF7と表示されてしまった気がします。

[cleaner]

Range("F7").Valueでできます。
しかもRangeのデフォルトはValueのはずなので.Valueはつけなくてもできるはずですが念のためつけておきましょう。

[mkmigmyuch]

ご教示いただきありがとうございます。
会社のPCでしか操作できないため、明日出社時に該当箇所を修正して稼働確認をしたいと思います。

[cleaner]

ついでなのですがデバッグの方法はご存知でしょうか？
もしご存知でないならデバッグについて調べて、Format関数辺りをウォッチ式で調べると解決しそうです。

[mkmigmyuch]

補足情報いただきありがとうございます。
インターネットからVBAを引っ張ってきた時にdebug.Printがあったのですが、よく分からず省いてしまっていました。
いま調べて理解できたので、debug機能も使って、エラーが起きている箇所を検知したいと思います！

[mkmigmyuch]

こんにちは。
ご教示いただいた方法で、正しく稼働させることができるようになりました。
かなり重要なツールだったので、大変助かりました。ありがとうございました。

Answer 1

Cells(Rows.Count, 1).End(xlUp).RowのCellsや、Format(Range("F7")) のRangeは、どのシートのもの？

Comments

[mkmigmyuch]

コメントいただきありがとうございます。
分かりづらくてすみません。
Cells〜は転記元のExcel、Format〜は転記先のExcelのセルを指定したいと考え、記載しています。

[cleaner]

途中まで所属が明記してあるのに一部だけ省略されているので、もしかしたらバグの原因になるかもしれません。今回は最初の5個以外うまくいってるので問題なさそうですが、バグを疑うときは他と違うところから探すといいですね。

[jinoji]

きっとそうだと思っていました。
book.Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Format(ThisWorkbook.Worksheets("sheet1").Range("F7"))
のように改めてみてはどうでしょうか。

[jinoji]

うまくファイル名がつかないパターンのときは、転記元のExcelを開いたときに転記対象のSheet1とは別のシートが前面になっているのではないかと推測しています。
xxx.Range と書かずに Rangeとだけ書くと、その時点でのActiveなシートが使われるため、意図しない値が取得されることがあります。

[mkmigmyuch]

ご教示いただきありがとうございます。
会社のPCでしか操作ができないため、省略されているCells〜のところと、Format〜のところを追記し、稼働確認をしてみます。

[mkmigmyuch]

こんにちは。
ご教示いただいた方法で、正しく稼働させることができるようになりました。
かなり重要なツールだったので、大変助かりました。ありがとうございました。