Ошибка времени выполнения 1004: Определенная пользователем или объектная ошибка

Question

Таким образом, приведенный ниже код копирует всю информацию на листе и вставляет информацию на новый лист excel при сохранении форматирования. Затем этот документ сохраняется с соглашением об именах имени активного листа и текущей даты. Этот лист сохраняется в двух местах, а затем закрывается. Когда я запускаю код, все шаги происходят, но документ не сохраняется в двух папках, и появляется сообщение об ошибке и останавливается там. Можете ли вы проверить мой код и посмотреть, почему он не работает? Заранее спасибо!

Sub SaveXLST() 
' 
' SaveXLST Macro 
' 
Dim monthVal As Integer 
Dim mVal As String 
Dim dayVal As Integer 
Dim dVal As String 
Dim yearVal As Integer 
Dim yVal As String 

monthVal = Month(Date) 
dayVal = Day(Date) 
yearVal = Year(Date) 

If monthVal < 10 Then 
    mVal = "0" & monthVal 
Else 
    mVal = "" & monthVal 
End If 

If dayVal < 10 Then 
    dVal = "0" & dayVal 
Else 
    dVal = "" & dayVal 
End If 

Cells.Select 
Range("A9").Activate 
Application.CutCopyMode = False 
Selection.Copy 
Workbooks.Add 
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ 
    , SkipBlanks:=False, Transpose:=False 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
ActiveWindow.SmallScroll Down:=-12 
Application.CutCopyMode = False 
ChDir "N:\D\IG\C\~ P" 
ActiveWorkbook.SaveAs Filename:= _ 
    "N:\D\IG\C\~P\T" & "-" & yearVal & "." & mVal & "." & dVal, FileFormat:= _ 
    xlOpenXMLWorkbook, CreateBackup:=False 
ChDir "N:\D\IG\C\T" 
ActiveWorkbook.SaveAs Filename:= _ 
    "N:\D\IG\C\T\T" & "-" & yearVal & "." & mVal & "." & dVal, FileFormat:= _ 
    xlOpenXMLWorkbook, CreateBackup:=False 
ActiveWindow.Close 
End Sub 

Answer 1

Вот ваш код с некоторыми незначительными корректировками/улучшений (в том числе и предложенные @ScottCraner и @Charlie в комментариях).

Option Explicit 

Sub SaveXLST() 
' 
' SaveXLST Macro 
' 
Dim monthVal As Integer 
Dim dayVal As Integer 
Dim yearVal As Integer 
Dim xlsNewFile As Workbook 

monthVal = Month(Date) 
dayVal = Day(Date) 
yearVal = Year(Date) 

Application.CutCopyMode = False 

'Indicate here from which sheet you want to copy 
ThisWorkbook.Worksheets("Sheet1").Range("A9").Copy 
Set xlsNewFile = Workbooks.Add 
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _ 
    , SkipBlanks:=False, Transpose:=False 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
ActiveWindow.SmallScroll Down:=-12 
Application.CutCopyMode = False 
If Dir("c:\tmp", vbDirectory) = vbNullString Then 
'If Dir("N:\D\IG\C\~ P", vbDirectory) <> vbNullString Then 
    MsgBox "No such path: N:\D\IG\C\~ P" & Chr(10) & "Skipping first save!" 
Else 
    xlsNewFile.SaveAs Filename:= _ 
     "c:\tmp\" & "-" & yearVal & "." & Format(monthVal, "00") & "." & Format(dayVal, "00") & ".xlsx", FileFormat:= _ 
     xlOpenXMLWorkbook, CreateBackup:=False 
End If 


If Dir("N:\D\IG\C\T\T", vbDirectory) = vbNullString Then 
    MsgBox "No such path: N:\D\IG\C\T\T" & Chr(10) & "Not saving to second location!" 
Else 
    xlsNewFile.SaveAs Filename:= _ 
     "N:\D\IG\C\T\T" & yearVal & "." & Format(monthVal, "00") & "." & Format(dayVal, "00") & ".xlsx", FileFormat:= _ 
     xlOpenXMLWorkbook, CreateBackup:=False 
End If 

xlsNewFile.Close 

End Sub 

Дайте мне знать, если это решит ваши проблемы/ошибки.