Transfer data from 3 object (table) to same sheet in excel

[Anonymous]

I have 3 object/table. I want to export these 3 data to same sheet in existing excel in my laptop.

Kindly help. You may provide example. I will try to study it. Thanks friend.

[Kushal_Chawda]

see this

QlikTip #32: Exporting multiple QV objects to a single Excel document

[tamilarasu]

Hi Ahmad,

Below link might be helpful for you.

Macro to export multiple tables in to single excel

[Anonymous]

Hi Nagaraj,

May I know how can i remove the first three line from the object? Thanks.

[tamilarasu]

Sorry. I didn't get you. Could you please elaborate.?

[Anonymous]

Sorry, what i actually mean is how can i exclude the first three table row during copy and paste to excel. Is it possible & once more, i try to save to existing excel in my laptop but not able to do it. Kindly help. Thanks Nagaraj.

[Anonymous]

sub exportToExcel

'==============================================================

' File Path & Name

Path = "C:\temp\"

FileName = "Test_"

strSaveFile = Path & FileName

'==============================================================

'Open Excel

set oXL=CreateObject("Excel.Application")

oXL.visible=True

oXL.Workbooks.Add

aSheetObj=Array("CH14","CH15","CH16")  ' Chart ID's here

'==============================================================

for i=0 to UBound(aSheetObj)

Set oSH = oXL.ActiveSheet

num_rows = oSH.UsedRange.Rows.Count

If num_rows = 1  then

oSH.Range("A1").Select   

Else

oSH.Range("A" & num_rows+1).Select

End If

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

obj.CopyTableToClipboard True

oSH.Paste

sCaption=obj.GetCaption.Name.v

set obj=Nothing 

oSH.Cells.Select

oSH.Columns("A").ColumnWidth = 12.17

oSH.Columns("B").ColumnWidth = 12.17

For j = 1 to 2

If num_rows = 1  then

'oSH.Range("A" & num_rows).Value = sCaption

'oSH.Range("A" & num_rows).Font.Bold = True

'oSH.Range("A" & num_rows).Font.ColorIndex = 3

'oSH.Range("A" & num_rows).Interior.ColorIndex = 40

oSH.Rows(num_rows).delete

Else

'oSH.Range("A" & num_rows+3).Value  = sCaption

'oSH.Range("A" & num_rows+3).Font.Bold = True

'oSH.Range("A" & num_rows+3).Font.ColorIndex = 3

'oSH.Range("A" &num_rows+3).Interior.ColorIndex = 40

oSH.Rows(num_rows+1).delete

End If

'oXL.Selection.Columns.AutoFit 

Next

Next

'==============================================================

  oSH.Range("A1").Select 

  oXL.Sheets("Sheet2").Delete

  oXL.Sheets("Sheet3").Delete

    oSH.Name = "Data"

   oXL.ActiveWorkBook.SaveAs strSaveFile & replace(date, "/", "-") & ".xlsx"

set oSH = Nothing   

set oXL=Nothing

end sub

Hi, I manage to delete the unwanted row in generated excel but still figuring how to save to existing excel.Kindly help

[tamilarasu · Accepted solution]

Ahmad,

I just modified the code according to your requirement. Have a look at the attachment.

Sub ExportToExcel

'==============================================================
' File Path & Excel Name

FileName = "C:\Users\Tamilarasu.Nagaraj\Desktop\New folder\Book4.xlsx"

'==============================================================
'Open Excel

set oXL=CreateObject("Excel.Application")
Set oSH=oXL.Workbooks.Open(FileName)
Set oFile=oXL.Workbooks(1)
oXL.visible=True    'Change false if you don't want to see the excel

SheetObj=Array("TB02")  ' Chart ID's here
'SheetObj=Array("TB01","TB02","TB03") 

'==============================================================
For i=0 to UBound(SheetObj)
Set oSH = oXL.ActiveSheet

num_rows = oSH.UsedRange.Rows.Count

If num_rows = 1  then
oSH.Range("A1").Select 
Else
oSH.Range("A" & num_rows+1).Select
End If

Set obj = ActiveDocument.GetSheetObject(SheetObj(i))
obj.CopyTableToClipboard True
oSH.Paste

If num_rows <> 1  then
oSH.Rows(num_rows + 1  & ":" & num_rows + 2).Entirerow.delete
End If

Set obj=Nothing
oSH.Cells.Select
oSH.Columns("A:D").ColumnWidth = 12.17

Next
'==============================================================
  oSH.Range("A1").Select
  oFile.Save
  oXL.Quit

set oSH = Nothing 
set oFile = Nothing
set oXL=Nothing
Msgbox "Data appended successfully.."
'==============================================================
end sub

Let me know, If you have any issues.