エクセルVBAが途中で止まります

以前別のカテゴリで質問したのですが、そちらでは解決出来なかったので、こちらで改めて質問します。
下記のマクロで、一つのブックからSheet1だけをコピーして来て、少し処理をし、元のブックを閉じるというもので、ブックの数は多くて3000程、少ない時は300位です。
で、このマクロだと９００位までですと最後まで行くのですが、それを超えるとリストが９５位で止まってしまいます。
自宅で別データを作ってやってみるとうまくいきました。
コピー元のブックにはテキストデータのみで、２００文字から５００文字程度の大きさしかありません。
ファイル名も５０文字程度の物を全部２０文字程度まで短くしてもみましたが、ダメでした。
どうかお知恵をお貸しください。

Sub ★1★ブックの結合()
Dim sFile As String
Dim sWB As Workbook, dWB As Workbook, aWB As Workbook
Dim dSheetCount As Long
Dim i As Long
Dim SOURCE_DIR As String

'エクセルデータに変換されたファイルのあるフォルダを選択します。
MsgBox "エクセルに変換されたデータのフォルダを選択"
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
SOURCE_DIR = .SelectedItems(1) & "\"
End If
End With

Application.ScreenUpdating = False

'指定したフォルダ内にあるブックのファイル名を取得
sFile = Dir(SOURCE_DIR & "*.xls")

'フォルダ内にブックが無ければ終了
If sFile = "" Then Exit Sub

'集約用ブックを作成
Set dWB = Workbooks.Add

'転記マクロの中のDMリストシートをコピーする
Workbooks("転記用マクロ.xlsm").Worksheets("DMリスト").Copy Before:=dWB.Worksheets("Sheet1")
Application.DisplayAlerts = False
Worksheets(Array("Sheet1", "sheet2", "sheet3")).Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

'集約用ブック作成時のシート数を取得
dSheetCount = dWB.Worksheets.Count

Do
'コピー元のブックを開く
Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)

'コピー元のsheet1を集約用ブックにコピー
sWB.Worksheets("sheet1").Copy After:=dWB.Worksheets(dWB.Sheets.Count)

シート転記

'コピー元ファイルを閉じる
Application.DisplayAlerts = False
sWB.Close
Application.DisplayAlerts = True

'セルA2の名前を変更する


'シート名をセルA2の値に変更
'ActiveSheet.Name = Range("A2").Value


'次のブックのファイル名を取得
sFile = Dir()
Loop While sFile <> ""

'集約用ブックを保存する
'dWB.SaveAs Filename:=DEST_FILE


Application.ScreenUpdating = False


End Sub

No.4 ベストアンサー 回答者： NyantaSapporo 回答日時： 2014/09/12 22:38

http://oshiete.goo.ne.jp/qa/8750372.html


例えば、30ファイルあっても10ファイルしか読み込まれない事があり、
エラーメッセージもない、何事もなく終了するが10ファイルしか処理されていない、
常に発生する訳ではなく、マシンが変われば同じデータでもOKだったり、
データが少し変わればOKだったりする。
なので、昨日までOKだったのに、今日データが変わった為、急にダメになったりする。
もし、10ファイル目で発生した場合、何度実行しても必ず、10ファイル目までしか処理されない。
そのファイルがおかしいかと思い、その前後の2～3ファイルを削除しても、
やっぱり、10ファイル目（さっきとは違うファイル）までしか処理されない、
という恐ろしいバグがExcel VBAにありますが、それじゃないですかね？

While文などのループの中に、ワークブックのオープンがあると、
何度目かでオープンが実行されず、エラーなしでスルンと終わります。

回避方法は、Open 文の前に　DoEvets　の１行を書く事。
だいたいこれで直りますが、これで直らなかったマクロもあったので、
Open 文の後ろにも　DoEvets　の１行を書いて、前後を　DoEvets　ではさむと直りました。
安全（？）の為、前後をはさんでおいた方が良いと思います。

こんな感じ：
DoEvents
Workbooks.Open aaa
DoEvents

かなり前（１年くらい？）にハマりググりまくったところ、ほとんど情報はなかったですが、
１人だけ、自分の質問に「直った」と自己回答している方がいて、Open文の前にDoEvetsをつけたら直ったそうです。
半信半疑で真似たら私も直りました。
何故、これで直るのかはわかりませんが、DoEvetsを外すと見事に再現し、DoEvetsではさむとピタッと直ります。

ググりまくった際、とても情報が少なく、こんなに顕著に再現するのに、
何故、情報が少ないのかは不思議に思いました。

この回答へのお礼

ご回答があった中で一番単純そうでしたので、一番初めに試した所、本当に何の問題もなく最後まで処理して完了しました。
１７００でも１４００でも大丈夫でした！
どこを探しても見つからなかった答えがあっさりと解決しました。
DoEventoの事も全く知らなかったので、勉強になりました。
本当にありがとうございました。

お礼日時：2014/09/18 10:41

No.5 回答者： hallo-2007 回答日時： 2014/09/15 17:39

こんな事を書くと答えにならないかもしれませんが。

うまくいった時の結果は、シート数が３０００枚ですよね。
エクセルのシート最大数はヴァージョンにもよりますが
多くはメモリーで決まるようです。
メモリーなので、貼り付けているシートの内容も影響します。
つまり、やろうとしていることに無理があると思います。

試しに、シートを追加して、内容をコピーするVBAを実行してみましたが
途中途中で挙動不審になり、終了したシートを確認していったら
１０２枚目に、編集できないシートがありました。

考え方ですが、他のブックの内容を、データとして
一枚のシートへひたすら縦方向へ追加していく方法を検討してみてください。

エクセルでシートを増やしていくデータの管理はパソコンに負担ですし
その手のデータでは集計もグラフも作れないでしょう。

この回答へのお礼

回答をありがとうございました。
このマクロはそのような処理をしながら進んで行くようにしていますが、何故か途中で終わってしまうので、悩んでいました。
また何かありましたらどうぞよろしくお願いします。

お礼日時：2014/09/18 10:35

No.3 回答者： pringlez 回答日時： 2014/09/12 22:29

>何行目で止まるかはわかりません。

>数千のブックがあるのに、出来上がったリストは
>90代程度しか出来ていなくて、エラーも何もなく終わってしまいます。

そもそもプログラムで問題が起きたときにまず最初に確認すべきことは、プログラムが正常終了しているのか異常終了しているのか確認することです。

「Do」の前に
「Debug.Print("ループ開始")」を

「Loop While sFile <> ""」の後ろに
「Debug.Print("ループ終了")」を書いて実行してみてください。

するとイミディエイトウインドウにメッセージが表示されます。
もしも「ループ開始」しか表示されないようであれば処理が途中で止まっているということです。

ループ内でもメッセージを出力する処理を何個所か書いて、どこで終了しているのか特定しましょう。


もしも「ループ終了」が表示されるのなら、おそらく処理は正常終了しています。95ファイル処理して終了するのなら、「対象ファイル」は物理的に95しか存在していないという可能性もあります。

Dirコマンドでオプション無指定で対象になるのは標準ファイルだけです。読み取り専用属性等のファイルは対象になりません。それが原因かもしれません。もしここが原因なら、すべてを標準ファイルにするか、プログラムを以下のように変更してみるといいと思います。

「sFile = Dir(SOURCE_DIR & "*.xls", 1)」とか
「sFile = Dir(SOURCE_DIR & "*.xls", 3)」とか。

この回答へのお礼

丁寧なご回答をありがとうございました。
回答をいただいた中で、簡単な物から試してみましたら、他の方の回答であっさりと解決してしまいました。
また躓きましたらこちらも次回参考にさせていただきますね。
どうぞ今後ともよろしくお願いします。

お礼日時：2014/09/18 10:43

No.2 回答者： bin-chan 回答日時： 2014/09/12 20:02

前の質問へのリンクですね。

何らかの経過があるならば、と思ったので。

何とも不思議な状態ですね。
時間がかかっても
> Application.ScreenUpdating = False
はコメントアウトしておくとか。

上手く行かない時、他のウインドウ操作したりせずに、じっと待つ。
そのためにはスクリーンセイバー・省電力は解除

> 'コピー元ファイルを閉じる
> Application.DisplayAlerts = False
> sWB.Close
> Application.DisplayAlerts = True
クローズした後
'コピー元ファイルを閉じる
Application.DisplayAlerts = False
sWB.Close
Set sWB = Nothing ’追加してみるとどうなります？
Application.DisplayAlerts = True



あと、気になったのがココ
> '集約用ブックを保存する
> 'dWB.SaveAs Filename:=DEST_FILE
本番ではコメントアウトを解除してありますか？

この回答へのお礼

素早いご回答をありがとうございました。
確かに一連の経過がありました。質問が杜撰で申し訳ありませんでした。
今後は過去の質問とのリンクも合わせて投稿させていただきます。
他の方の回答で解決しましたので、また躓いた時に参考にさせて下さい。
本当にありがとうございました。

お礼日時：2014/09/18 10:47

No.1 回答者： bin-chan 回答日時： 2014/09/11 19:57

> それを超えるとリストが９ ５位で止まってしまいます。

「どこの行で」「どう」止まる？
・エラーメッセージは出ますか？出るなら何と書いてますか？どこの行ですか？
・何もエラーは出ないが目的の結果が得られない？

> 自宅で別データを作ってやってみるとうまくいきました。
・データによって、うまく行く／行かないがあるなら、両方で同じデータを用いることができますか？

続きの質問なら、せめてアンカーを付けてはどうでしょう？

この回答への補足

早速ありがとうございます。
アンカーなるものがちょっとわからないのですが、以前した質問へのリンクということでしょうか？
その時の質問はレスが付かなかったため、削除しました。

何行目で止まるかはわかりません。
数千のブックがあるのに、出来上がったリストは90代程度しか出来ていなくて、エラーも何もなく終わってしまいます。
大体いつも同じ位の所で終わるようですが、200位の時でも最後までリストを作ってくれることもあります。
自宅にデータを持って帰ることは出来ないので、大体似たような物を作り、コピーしてきた後の動きも少し単純にしています。
ですが以前、シートをコピーした後の動きをつけずに、ただひたすらシートをコピーしてくるだけのものを作ってみたのですが、その時も同じように90過ぎ位で終了してしまいました。
データが大きくなってしまうのが原因かと思い、いっそのことコピーした後の動きを一緒にして、データが大きくならないようにしてみたのですが、やっぱり同じことでした。

補足日時：2014/09/11 20:36

この回答へのお礼

大変助かりました。
ありがとうございました。

お礼日時：2014/09/18 10:47