Я импортирую листы в файл, затем сохраняю файл с новым именем в другом месте.
Макрос работает до тех пор, пока использование памяти в Excel не достигнет около 3000 МБ, после чего «из Память »возникает ошибка. (На этом P C. Имеется 32 ГБ памяти.)
Ошибка в этой строке Set Wkb3 = Workbooks.Open(filename:=Path & "\" & filename), вероятно, из-за недостатка памяти для открытия другого файла.
Wkb3 , являющийся исходным файлом, из которого импортируется лист, закрывается после импорта.
Wkb2, содержащий коллекцию импортированных листов, сохраняется и закрывается после завершения импорта.
Wkb1 - единственный, который постоянно открыт.
Мне обычно удается выполнить go через 40 или около того итераций до того, как cra sh, так что даже если все Wkb2 и Wkb3 закрыты, что-то оставаясь в памяти Excel.
Я пытался сохранять Wkb2 после каждого импорта, чтобы посмотреть, освободит ли это память.
Я пытался установить Objects в ничего.
Вот мой макрос:
Option Explicit
Sub CombineFiles()
Call NewBook 'this marco creates a new file that will hold the imported sheets
Dim Wkb1 As Workbook 'Wkb with Macro
Set Wkb1 = ThisWorkbook
Dim Aname As String
Aname = Wkb1.Sheets(1).Range("A1").Value & "\Master File\Master File.xlsx" 'cell A1 holds the path for each individual folder that holds files that need to be combined
Dim Wkb2 As Workbook 'MasterBook
Set Wkb2 = Workbooks.Open(filename:=Aname)
Dim Wkb3 As Workbook 'DataSource
Dim ws1 As Worksheet 'Wkb with Macro
Set ws1 = Wkb1.Worksheets(1)
Dim ws3 As Worksheet 'DataSource
Dim MyOldName As String
MyOldName = Wkb2.FullName
Dim Path As String
Path = ws1.Range("A1").Value
Dim filename As String
filename = Dir(Path & "\*.xlsx", vbNormal)
Dim Path2 As String
Dim filename2 As String
Path2 = Path & "\Master File\"
Do Until filename = ""
Set Wkb3 = Workbooks.Open(filename:=Path & "\" & filename)
For Each ws3 In Wkb3.Worksheets
ws3.Copy after:=Wkb2.Sheets(Wkb2.Sheets.Count)
Next ws3
Wkb3.Close False
filename = Dir()
Loop
Application.DisplayAlerts = False
filename2 = Wkb2.Worksheets(2).Range("A2").Text
Wkb2.SaveAs filename:=Path & filename & ".xlsx"
Wkb2.Close True
Kill MyOldName
Call KillFiles
Application.DisplayAlerts = True
End Sub