调整代码将excel文件的sheet1复制到sheet1新的excel文件 [英] Tweak code to copy sheet1 of a excel file to sheet1 new excel file

问题描述

我有代码将所有的表从一个excel文件复制到另一个，但是我只有一个工作表，当它复制时，将原件作为sheet1（2）粘贴到目标文件中。

我需要代码才能创建一个刚刚过去的sheet1到目标文件的sheet1的新表单

我试过玩，但可以没有得到它

谢谢

  Sub CopySheets（）
 
 Dim WB As Workbook 
 Dim SourceWB As Workbook 
 Dim WS As Worksheet 
 Dim ASheet As Worksheet 
 
'关闭屏幕更新和事件：
 Application.ScreenUpdating = False 
 Application.EnableEvents = False 
 
'设置变量：
设置WB = ActiveWorkbook 
设置ASheet = ActiveSheet 
设置SourceWB = Workbooks.Open（WB.Path&\MyOtherWorkbook.xls）'修改以匹配
 
'将每个表的SourceWB复制到原始wb的结尾：
对于每个WS In SourceWB.Worksheets 
 WS.Copy a fter：= WB.Sheets（WB.Sheets.Count）
下一个WS 
 
 SourceWB.Close savechanges：= False 
设置WS = Nothing 
 Set SourceWB = Nothing 
 
 WB.Activate 
 ASheet.Select 
设置ASheet = Nothing 
设置WB = Nothing 
 
 Application.EnableEvents = True 
 
 End Sub 
  

解决方案

请尝试下面的代码。如果源工作簿在excel 2010（xlsx）中，并且目标工作簿在excel 2003（xls）中，以下代码可能会失败。您也可以查看 RDBMerge Addin 。

  Sub CopySheets（）
 
 
 Dim SourceWB As Workbook，DestinWB As Workbook 
 Dim SourceST As Worksheet 
 Dim filePath As String 
 
'关闭屏幕更新和事件：
 Application.ScreenUpdating = False 
 Application.DisplayAlerts = False 
 
 
'路径是指您的LimeSurvey工作簿
设置SourceWB = Workbooks.Open（ThisWorkbook.Path&\LimeSurvey.xls）
'设置源表
设置SourceST = SourceWB。 （管理套件反馈 -  Tri）
 
 SourceST.Copy 
设置DestinWB = ActiveWorkbook 
 filePath = CreateFolder 
 
 DestinWB.SaveAs filePath 
 DestinWB.Close 
设置DestinWB =没有
 
设置SourceST =没有
 SourceWB.Close 
设置SourceWB =没有
 
 Application.ScreenUpdating = True 
 Application.DisplayAlerts = True 
 
 End Sub 
函数CreateFolder（）As String 
 
 Dim fso As Object，MyFolder As String 
设置fso = CreateObject（Scripting.FileSystemObject）
 
 MyFolder = ThisWorkbook.Path& \Reports
 
 
如果fso.FolderExists（MyFolder）= False然后
 fso.CreateFolder（MyFolder）
如果
 
 MyFolder = MyFolder& \&格式（Now（），MMM_YYYY）
 
如果fso.FolderExists（MyFolder）= False然后
 fso.CreateFolder（MyFolder）
如果
 
 CreateFolder = MyFolder& \Data&格式（Now（），DD-MM-YY hh.mm.ss）& .xls
设置fso = Nothing 
 
结束函数
  

I have the code to copy all the sheets from one excel file to another, but I only have one sheet and when it copies it paste the original as sheet1 (2) in to the destination file.

I need the code to not create a new sheet just past sheet1 into sheet1 of the destination file

I tryed playing with it but could not get it

Thanks

Sub CopySheets()

Dim WB As Workbook
Dim SourceWB As Workbook
Dim WS As Worksheet
Dim ASheet As Worksheet

'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.EnableEvents = False

 'Sets the variables:
 Set WB = ActiveWorkbook
 Set ASheet = ActiveSheet
 Set SourceWB = Workbooks.Open(WB.Path & "\MyOtherWorkbook.xls")  'Modify to match

'Copies each sheet of the SourceWB to the end of original wb:
For Each WS In SourceWB.Worksheets
    WS.Copy after:=WB.Sheets(WB.Sheets.Count)
Next WS

    SourceWB.Close savechanges:=False
    Set WS = Nothing
    Set SourceWB = Nothing

WB.Activate
ASheet.Select
    Set ASheet = Nothing
    Set WB = Nothing

Application.EnableEvents = True

End Sub

解决方案

Try below code.The below code can fail if the source workbook is in excel 2010 (xlsx) and destination workbook is in excel 2003 (xls). You may also have a look at RDBMerge Addin.

   Sub CopySheets()


    Dim SourceWB As Workbook, DestinWB As Workbook
    Dim SourceST As Worksheet
    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")
    'set source sheet
    Set SourceST = SourceWB.Sheets("Management Suite Feedback - Tri")

    SourceST.Copy
    Set DestinWB = ActiveWorkbook
    filePath = CreateFolder

    DestinWB.SaveAs filePath
    DestinWB.Close
    Set DestinWB = Nothing

    Set SourceST = Nothing
    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

这篇关于调整代码将excel文件的sheet1复制到sheet1新的excel文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！