Изменить копию листа1 для копирования рабочей книги в макрос

Question

Я пытаюсь изменить следующий код, который копирует sheet1 из активной книги и сохраняет его в папку с помощью функции CreateFolder, все работает хорошо.

Отсюда: Tweak code to copy sheet1 of a excel file to sheet1 new excel file

Я пытаюсь изменить его, чтобы скопировать всю книгу, чтобы отправить в папку, созданную на CreateFolder.

Благодаря

Edit: Обновлен код

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