Я делаю отдельные файлы данных по дневной цене для тикеров из файла данных по дневной цене.Код программы, добавленный ниже, не работает должным образом.Иногда он запускает и создает 60 файлов, а затем не может сохранить файл и впоследствии не может вставить данные требуемого диапазона, хотя создает файлы.В других случаях может быть невозможно сохранить даже после 5-го файла или может быть после 30-го файла.Я даже ввел время паузы.
Application.Wait (Now + #12:00:03 AM#)
Но это не решает проблему.Произошел сбой программы в следующей строке кода.
.SaveAs Filename:="C:\Users\kakka\Desktop\SymbolData\" & cell & "-v1.xls", FileFormat:=56
Код программы добавлен ниже.
Sub number()
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
Dim cell, rng As Range
Dim stRw As Long
Set rng = Range("A2:A72")
stRw = 2
For Each cell In rng
If cell.Value <> cell.Offset(1, 0).Value Then
Set wbI = ActiveWorkbook
Set wsI = wbI.Worksheets("Sheet1")
Set wbO = Workbooks.Add
With wbO
Set wsO = wbO.Sheets("Sheet1")
.SaveAs Filename:="C:\Users\kakka\Desktop\SymbolData\" & cell & "-v1.xls", FileFormat:=56
wsI.Range("A1:H1").Copy
wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wsI.Rows(stRw & ":" & cell.Row).Copy
wsO.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Close SaveChanges:=True
stRw = cell.Row + 1
End With
Set wbI = Nothing
Set wsI = Nothing
Set wbO = Nothing
Set wsO = Nothing
End If
Application.Wait (Now + #12:00:03 AM#)
Next cell
End Sub
Запросить помощь в решении этой проблемы.