Tweak code to copy sheet1 of a excel file to sheet1 new excel file

Question

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

Answer 1

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