更改复制Sheet1到宏中的复制工作簿

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

从这里：Tweak code to copy sheet1 of a excel file to sheet1 new excel file

我已经试图改变它的整个工作簿发送到由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

来源

2013-05-05 xyz

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

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

来源

2013-05-05 16:26:01 Santosh

桑托斯你的代码是如此的帮助，我需要它的另一个项目！我更新了我正在使用的代码（上面），代码运行后，一切正在工作'except'我的屏幕上没有显示文件（excel已打开但没有活动文件），在原始版本之后代码运行我有原始文件显示。有没有办法让这个版本做同样的事情？ '谢谢' – xyz 2013-05-05 16:53:47

@Tim上面的代码根据'SourceWB'打开一个工作簿，并简单地执行一个SaveAs来复制并存储在文件夹中。 – Santosh 2013-05-05 17:00:49

我改变了'Set SourceWB = Workbooks.Open（ThisWorkbook.Path＆“\ LimeSurvey.xls”）'设置SourceWB = ActiveWorkbook'，这似乎是导致丢失的文件显示在最后？ – xyz 2013-05-05 17:09:28

更改复制Sheet1到宏中的复制工作簿

回答

相关问题