調整代碼以將Excel文件的sheet1復制到sheet1新的Excel文件

Question

我有將所有工作表從一個excel文件復制到另一個工作表的代碼，但是我只有一個工作表，當它復制時，將原始文件sheet1（2）粘貼到目標文件中。

我需要代碼以不在目標文件的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