使用 Excel vba 创建 Active Sheet 的备份副本

Creating a backup copy of Active Sheet using Excel vba

我需要创建活动 Sheet 的备份副本 - 到新工作簿中。 这样创建的新工作簿中只有 Active Sheet(没有宏,没有 vba)

我需要它发生在“打开后”我的作品sheet事件

正在执行以下操作:

     Private Sub Workbook_Open()
     
     ActiveWorkbook.SaveCopyAs "E:\Projects\FolderName\FileName.xlsm"
                         
     End Sub

它复制了整个工作簿,其中包含所有 vba 代码和宏,这不是我需要的。

有没有办法只复制 Active Sheet?

理想情况下,我希望有单元格引用(我将文件路径存储在另一个 sheet 中,在一个名为“BackupPath”的单独单元格中)。

这是你想要的吗?

Private Sub Workbook_Open()
Var_Path = "D:...\Wb2.xls"
File1 = ActiveWorkbook.Name
Workbooks.Open Var_Path, 0, ReadOnly:=False

File2 = ActiveWorkbook.Name
Workbooks(File1).Sheets("Feuil1").Copy Before:=Workbooks(File2).Sheets("Feuil3")
End Sub

(在此处查找:Some Forum subject

要从另一个单元格打开,您可以将 Var_Path = "D:...\Wb2.xls" 替换为 Var_Path = range("A1").text(考虑到范围 A1 是您的单元格“BackupPath”)

请尝试下一个代码:

Private Sub Workbook_Open()
  Dim wb As Workbook, shC As Worksheet
  Dim sh As Worksheet, i As Long, strBackup As String, arr As Variant
  
  Set shC = ThisWorkbook.ActiveSheet 'this should be clear...
  strBackup = Range(ThisWorkbook.Names("BackupPath")).Value 'extract the string from the named range
  Set wb = Workbooks.Add             'open a new workbook
   shC.Copy before:=wb.Worksheets(1) 'copy the active sheet before the existing one
   If wb.Worksheets.Count > 1 Then
        'delete all sheets, except the first
        For i = wb.Worksheets.Count To 2 Step -1
          Application.DisplayAlerts = False
            wb.Worksheets(i).Delete
          Application.DisplayAlerts = False
        Next i
   End If
   arr = Split(strBackup, ".") 'split the path on the dot "."
                               'the last array element will be extension
   arr(UBound(arr)) = "xlsx"   'change exiting extension with "xlsx"
   strBackup = Join(arr, ".")  'join the processed array and obtain the correct path
   wb.SaveAs strBackup, xlWorkbookDefault 'save the workbook
   wb.Close False                         'close it without saving
   
   MsgBox "A backup has been done, like " & strBackup
End Sub