将“复制工作表1”更改为“在宏中复制工作簿”

Question

我正在尝试更改以下代码，该代码将sheet1从活动工作簿中复制并通过一个名为CreateFolder的函数将其保存到文件夹中，所有工作良好。

From Here:调整代码将excel文件的sheet1复制到新的excel文件sheet1

我试图将其更改为复制整个工作簿以发送到由CreateFolder创建的文件夹。

感谢

编辑:更新代码

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