How to Combine Multiple Files into one Excel workbook with different worksheer

[hykal1993]

Hi,

I have written Macro code to export few report (Main, Enabler and Wholesale). I would like to retain and add another code to extract all the report into one with multiple sheet. Any idea, guys? My code is below, rather not change much

'Main

sub exportToExcelMain

Dim path

path = getExportPathMain()

dim o

Set o = ActiveDocument.GetSheetObject("Main")

o.ExportBiff path

Set o = nothing

msgbox("Export to " & path & " succeeded!")

end sub

function getExportPathMain

getExportPathMain = ActiveDocument.Variables("Main Export").GetContent.String

end function

'Enabler

sub exportToExcelEnabler

Dim path

path = getExportPathEnabler()

dim o

Set o = ActiveDocument.GetSheetObject("Enabler")

o.ExportBiff path

Set o = nothing

msgbox("Export to " & path & " succeeded!")

end sub

function getExportPathEnabler

getExportPathEnabler = ActiveDocument.Variables("Enabler Export").GetContent.String

end function

'Wholesale

sub exportToExcelWholesale

Dim path

path = getExportPathWholesale()

dim o

Set o = ActiveDocument.GetSheetObject("Wholesale")

o.ExportBiff path

Set o = nothing

msgbox("Export to " & path & " succeeded!")

end sub

function getExportPathWholesale

getExportPathWholesale = ActiveDocument.Variables("Wholesale Export").GetContent.String

end function

[andrey_krylov]

Try this

Sub Export

  set oXL = CreateObject("Excel.Application")

  oXL.DisplayAlerts = False

  oXL.visible=True 'False ti hide the excel

  Dim oXLDoc 'as Excel.Workbook

  Dim i

  Set oXLDoc = oXL.Workbooks.Add

    FilePath =  ActiveDocument.Variables("vPath").GetContent.String

  FileName =  "Test"

  '---------------------------------------

  SheetObj=Array("CH02","CH04","CH05")                    'Chart ID's

  '---------------------------------------

  for i=0 to UBound(SheetObj)

  'ActiveDocument.GetApplication.WaitForIdle

  oXL.Sheets.Add

  oXL.ActiveSheet.Move ,oXL.Sheets( oXL.Sheets.Count )

Set oSH = oXL.ActiveSheet

    oSH.Range("A1").Select

    Set obj = ActiveDocument.GetSheetObject(SheetObj(i))

    obj.CopyTableToClipboard True

    oSH.Paste

    sCaption=obj.GetCaption.Name.v

    Set obj=Nothing

  oSH.Rows("1:1").Select

  oXL.Selection.Font.Bold = True

  oSH.Cells.Select

    oXL.Selection.Columns.AutoFit

    oSH.Range("A1").Select   

  oSH.Name=left(sCaption,30)

  Set oSH=Nothing

  Next

'---------------------------------------

  Call Excel_DeleteBlankSheets(oXLDoc)

'---------------------------------------

  oXL.DisplayAlerts = True

    oXLDoc.Sheets(1).Select

  If FilePath <>"" then

  oXLDoc.SaveAs FilePath & "\" & FileName & ".xlsx"

  Else

  Msgbox "Folder path can not be empty. Enter Valid path"

  Exit Sub

  End If

  oXLDoc.Close FALSE

  oXL.Quit

  Set oXL    =Nothing

  Set oXLDoc =Nothing

End Sub

Private Sub Excel_DeleteBlankSheets(ByRef oXLDoc)

  For Each ws In oXLDoc.Worksheets

        If oXLDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then

  On Error Resume Next

    Call ws.Delete()

  End If

  Next

End Sub

[hykal1993]

Thank you. I amend your script a little based on my object and path name. When I click the button, it brings me back to the script. Can you help check the script amended below? Thanks a lot for your help!

Sub Export

set oXL = CreateObject("Excel.Application")

oXL.DisplayAlerts = False

oXL.visible=True 'False ti hide the excel

Dim oXLDoc 'as Excel.Workbook

Dim i

   Set oXLDoc = oXL.Workbooks.Add

    FilePath =  ActiveDocument.Variables("Main Export").GetContent.String

FileName =  "Test"

'---------------------------------------

SheetObj=Array("Main","Wholesale","Retail")                    'Chart ID's

'---------------------------------------

for i=0 to UBound(SheetObj)

'ActiveDocument.GetApplication.WaitForIdle

oXL.Sheets.Add

oXL.ActiveSheet.Move ,oXL.Sheets( oXL.Sheets.Count )

Set oSH = oXL.ActiveSheet

    oSH.Range("A1").Select

    Set obj = ActiveDocument.GetSheetObject(SheetObj(i))

    obj.CopyTableToClipboard True

    oSH.Paste

    sCaption=obj.GetCaption.Name.v

    Set obj=Nothing

oSH.Rows("1:1").Select

oXL.Selection.Font.Bold = True

    oSH.Cells.Select

    oXL.Selection.Columns.AutoFit

    oSH.Range("A1").Select    

oSH.Name=left(sCaption,30)

Set oSH=Nothing

Next

'---------------------------------------

  Call Excel_DeleteBlankSheets(oXLDoc)

'---------------------------------------

oXL.DisplayAlerts = True

    oXLDoc.Sheets(1).Select

   If FilePath <>"" then

oXLDoc.SaveAs FilePath & "\" & FileName & ".xlsx"

Else

Msgbox "Folder path can not be empty. Enter Valid path"

Exit Sub

   End If

   oXLDoc.Close FALSE

   oXL.Quit

Set oXL    =Nothing

Set oXLDoc =Nothing

End Sub

'--------------------------------------------------------------------

Private Sub Excel_DeleteBlankSheets(ByRef oXLDoc)

  For Each ws In oXLDoc.Worksheets

        If oXLDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then

On Error Resume Next

    Call ws.Delete()

End If

  Next

End Sub

'--------------------------------------------------------------------

[hykal1993]

Also, I tried to click export in your file, it brings me back to the script page (I have changed the path to my local btw)

[andrey_krylov · Accepted solution]

Hi, try this. It must work

[hykal1993]

It still doesn't work. I tried to replace with your object and path in your file, it will bring me back to the script. Can you change according to your object, let me run and check whether it work first. I'll replace with my objects once it works.

Thank you!

[andrey_krylov]

I download the attached file and it works. Run this macro in Macro Editor and see the message

[hykal1993]

I changed the path to my local

When I click export, the script comes out

[hykal1993]

The error says ActiveX component can't create object: 'Excel.Application'

[andrey_krylov]

Switch to Allow System Access