时间戳

首页 > 解决方案 > 我想将选择另存为新工作簿，但如果工作簿已经存在，我想在现有工作簿中另存为新工作表

excel - 我想将选择另存为新工作簿，但如果工作簿已经存在，我想在现有工作簿中另存为新工作表

问题描述

我对此还是很陌生。我希望能够做到以下几点：

  1. 选择复制范围
  2. 在新工作簿中粘贴选择
  3. 将工作簿保存在 H5 范围内找到年份值的文件夹中（如果文件夹不存在，则创建一个）
  4. 将文件另存为范围 A5、F5、H5 中的“title_month_year”值（但如果文件已存在，则另存为新工作表/选项卡）

到目前为止，我相信我已经覆盖了 1-3 个和 4 个的一部分。

Option Explicit
Const MYPATH As String = "C:\USERS\3658\Desktop\"

Sub IfNewFolder()
Dim AuditYear As String
    AuditYear = Range("H5").Value

'if a particular directory doesnt exists already then create folder.
If Len(Dir(MYPATH & AuditYear, vbDirectory)) = 0 Then
   MkDir MYPATH & AuditYear
End If

End Sub



Sub SaveCustomizedCourse()
'copy and past selected data in a new workbook

Range("B8").End(xlDown).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.Copy

    Workbooks.Add
    ActiveSheet.Paste

    Range("A1").Select
    Selection.PasteSpecial xlPasteColumnWidths
    Selection.PasteSpecial xlPasteFormats


'save selected data in a new workbook
Dim AuditMonth As String
Dim AuditYear As String
Dim AuditTitle As String

    AuditMonth = Range("F5").Value 'MONTH
    AuditYear = Range("H5").Value 'YEAR
    AuditTitle = Range("A5").Value 'TITLE

    IfNewFolder 'creates a yearly subfolder

    ActiveWorkbook.SaveAs Filename:= _
    MYPATH & AuditYear & "\" & AuditTitle & "_" & AuditMonth & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

        MsgBox ("Audit Saved.")

        'ActiveWindow.Close

End Sub

标签： excelvbaworksheetsave-as

解决方案

您可以添加以下子程序并在其后调用它IfNewFolder并删除其后的所有代码。

Private Sub Carla(AuditMonth, AuditYear, AuditTitle)

Dim CurWb           As Workbook 'This is whatever workbook you are working with
Dim SaveAsWb        As Workbook 'This is spare for the workbook in case that has the same name
Dim SaveFileName    As String

Set CurWb = ActiveWorkbook
SaveFileName = AuditYear & "\" & AuditTitle & "_" & AuditMonth & ".xlsm"

If Len(Dir(MYPATH & SaveFileName)) = 0 Then
    CurWb.SaveAs FileName:=MYPATH & SaveFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
    Set SaveAsWb = Workbooks.Open(MYPATH & SaveFileName)
    CurWb.Worksheets("Sheet1").Copy After:=SaveAsWb.Worksheets(Sheets.Count)
    SaveAsWb.Save
    SaveAsWb.Close
End If

MsgBox ("Audit Saved.")

End Sub

推荐阅读