將復制工作表1更改為在宏中復制工作簿

Question

我正在嘗試更改以下代碼，該代碼從活動工作簿中復制sheet1並將其保存到一個名為CreateFolder的函數的文件夾中，一切正常。

從這里： 調整代碼以將Excel文件的sheet1復制到sheet1新的Excel文件

我試圖更改它以復制整個工作簿，以發送到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