以前別のカテゴリで質問したのですが、そちらでは解決出来なかったので、こちらで改めて質問します。 下記のマクロで、一つのブックから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
↧