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

如果这解决了您的问题/错误，请告诉我。

运行时错误1004：应用程序定义的错误或对象定义的错误

1 个答案: