Ok..the following is a complete sample code which I' am using to export data from the various tabs on the click of a button.. you need to take a button and on it's macro part you need to write the following code
sub
sendtoexcel
Dim
FSO
Set
FSO =
CreateObject("scripting.filesystemobject"
)
"G:\QlikView_MIS_Excel\"
On
Error Resume Next
"*.xls"
, True
On
Error GoTo 0
dim
ObjCaption
dim
name,counter
Dim
MyPath
for
j = 1 to ActiveDocument.NoOfSheets - 1
set
XLApp =
CreateObject("Excel.Application"
)
'XLApp.Visible = True
set
XLDoc = XLApp.Workbooks.Add
set
XLSheet = XLDoc.Worksheets(1)
'set s=ActiveDocument.ActiveSheet
set
s= ActiveDocument.GetSheet(j)
set
sp=s.GetProperties
'msgbox(name)
'XLDoc.Name=name
for
i=0 to s.NoOfSheetObjects-1
set
obj=s.SheetObjects(i)
if
id=10
or id=11
then 'or id=11 or id=15 then '10 for chart
'if ObjCaption<>" " then
TRUE
On
Error Resume Next
true
On
Error GoTo 0
Select
if
name="Monthly Trend"
then
if
ObjCaption="QlikView wise policies in Pipe"
then
while
not(
IsEmpty (XLSheet.Cells(counter,2)))
wend
elseif
ObjCaption="Day wise Annualised Premium(Rs.Mn) of Policies in Pipeline (Rs. )"
then
while
not(
IsEmpty (XLSheet.Cells(counter,2)))
wend
else
while
not(
IsEmpty (XLSheet.Cells(counter,4)))
wend
end
if
elseif
name="Weekly MIS"
then
while
not(
IsEmpty (XLSheet.Cells(counter,1)))
wend
elseif
name="AM & Advisors Wise"
then
while
not(
IsEmpty (XLSheet.Cells(counter,5)))
wend
else
while
not(
IsEmpty (XLSheet.Cells(counter,3)))
wend
end
if 'else
' obj.CopyTableToClipboard true
' XLSheet.Cells(counter+1,1).Select
' XLSheet.Paste
' counter=counter+2
' while not(IsEmpty(XLSheet.Cells(counter,3)))
' counter=counter+1
' wend
'end if
Set
WshShell =
CreateObject("WScript.Shell"
)
"cmd /c ""echo off | clip"""
,0,
True
end
if
next
Set
WshShell =
CreateObject("WScript.Shell"
)
"cmd /c ""echo off | clip"""
,0,
True
"F:\Daily_QlikView_Excel\"
&name&".xls"
True
next
Set
FSO =
CreateObject("scripting.filesystemobject"
)
"F:\Daily_MIS_Excel\"
'FSO.deletefile MyPath & "Main.xls", True
"Attributes.xls"
,
True
"Metric.xls"
, True
"Headings1.xls"
, True
"Headings2.xls"
, True
"Headings3.xls"
, True
"Headings4.xls"
, True
'FSO.deletefile MyPath & "Sheet16.xls", True
'FSO.deletefile MyPath & "Sheet17.xls", True
'FSO.deletefile MyPath & "Sheet18.xls", True
'FSO.deletefile MyPath & "Sheet19.xls", True
'FSO.deletefile MyPath & "Sheet20.xls", True
'FSO.deletefile MyPath & "Sheet21.xls", True
'FSO.deletefile MyPath & "Sheet22.xls", True
'FSO.deletefile MyPath & "Sheet23.xls", True
'FSO.deletefile MyPath & "Sheet24.xls", True
'FSO.deletefile MyPath & "Sheet25.xls", True
end
sub
Ofcourse you need to make certain small changes as per your requirments
Regards
Gaurav
.png "Miguel_Angel_Baeyens"){kind=avatar}
