调整代码将excel文件的sheet1复制到sheet1新的excel文件中

我有代码复制所有工作表从一个Excel文件到另一个，但我只有一个工作表，当它复制它粘贴原始sheet1（2）到目标文件。

我需要的代码不会创build一个新的工作表刚过sheet1到目标文件的sheet1

我尝试玩它，但无法得到它

谢谢

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 

Answer 1

尝试下面的代码。如果源工作簿是在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 '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