将复制Sheet1更改为在macros中复制工作簿

我试图改变下面的代码，从活动工作簿中复制sheet1，并使用一个名为CreateFolder的函数将其保存到一个文件夹中，这一切都很好。

从这里： 调整代码将excel文件的sheet1复制到sheet1新的excel文件

我试图改变它复制整个工作簿发送到由CreateFolder创build的文件夹。

谢谢

编辑：更新的代码

Sub CopySheets() Dim SourceWB As Workbook Dim filePath As String 'Turns off screenupdating and events: Application.ScreenUpdating = False Application.DisplayAlerts = False 'path refers to your LimeSurvey workbook Set SourceWB = ActiveWorkbook filePath = CreateFolder SourceWB.SaveAs filePath SourceWB.Close Set SourceWB = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Function CreateFolder() As String Dim fso As Object, MyFolder As String Set fso = CreateObject("Scripting.FileSystemObject") MyFolder = ThisWorkbook.Path & "\360 Compiled Repository" If fso.FolderExists(MyFolder) = False Then fso.CreateFolder (MyFolder) End If MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY") If fso.FolderExists(MyFolder) = False Then fso.CreateFolder (MyFolder) End If CreateFolder = MyFolder & "\360 Compiled Repository" & " " & Range("CO3") & " " & Format(Now(), "DD-MM-YY hh.mm") & ".xls" Set fso = Nothing End Function 

Answer 1

要复制整个工作簿，您可以使用下面的代码

 Sub CopySheets() Dim SourceWB As Workbook Dim filePath As String 'Turns off screenupdating and events: Application.ScreenUpdating = False Application.DisplayAlerts = False 'path refers to your LimeSurvey workbook Set SourceWB = Workbooks.Open(ThisWorkbook.Path & "\LimeSurvey.xls") filePath = CreateFolder SourceWB.SaveAs filePath SourceWB.Close Set SourceWB = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub Function CreateFolder() As String Dim fso As Object, MyFolder As String Set fso = CreateObject("Scripting.FileSystemObject") MyFolder = ThisWorkbook.path & "\Reports" If fso.FolderExists(MyFolder) = False Then fso.CreateFolder (MyFolder) End If MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY") If fso.FolderExists(MyFolder) = False Then fso.CreateFolder (MyFolder) End If CreateFolder = MyFolder & "\Data " & Format(Now(), "DD-MM-YY hh.mm.ss") & ".xls" Set fso = Nothing End Function