Cambiar Copiar hoja 1 para Copiar libro de trabajo en macro

I am trying to alter the following code which copies sheet1 from the active workbook and saves it to a folder by with a function called CreateFolder, all works well.

De aquí: Tweak code to copy sheet1 of a excel file to sheet1 new excel file

I have trying to alter it to copy the entire workbook to send to the the folder created by CreateFolder.

Muchas Gracias

Edit: Updated Code

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

preguntado el 05 de mayo de 13 a las 17:05

1 Respuestas

To copy entire workbook you can use the below code

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

contestado el 05 de mayo de 13 a las 17:05

Santosh your code was so helpful I needed it for another project!. I up-dated the code I am using (above), everything is working except after the code runs I there is no file showing on my screen (excel is open but there is no file active), In the original version after the code runs I have the original file showing. Is there a way for this version to do the same? Thank you - xyz

@Tim The above code opens a workbook as per SourceWB and simply does a SaveAs to make a copy and stores in the folder. - Santosh

Cambié Set SourceWB = Workbooks.Open(ThisWorkbook.Path & "\LimeSurvey.xls") a Set SourceWB = ActiveWorkbook and this seems to be causing the loss of file showing at the end maybe? - xyz

I tryed adding Application.Workbooks.Open ThisWorkbook.Path & "\Macro360" (the name of my workbook that the code is being exacuted in)to the end of the sub but did not work - xyz

@Tim If you want to make a copy of the workbook which has the code then you can use this Set SourceWB = ThisWorkbook - Santosh

No es la respuesta que estás buscando? Examinar otras preguntas etiquetadas or haz tu propia pregunta.