Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Dear All,
I have below Macro code which basically exports 4 objects to 4 different sheets.
For first 3 sheets its working fine but for 4th sheet (Set XLSheet4 = XLDoc.Worksheets("Sheet4") ) it's giving the error 'Subscript out of range'.
Can you please help me on this.
set V = ActiveDocument.Variables("vToday")
vTODAY =V.GetContent.String
function Export()
Set XLApp = CreateObject("Excel.Application")
XLApp.Visible = False
Set XLDoc = XLApp.Workbooks.Add
FileName = "E:\LeMS\LeMS - Lead Status Summary"&"_"&vTODAY
set obj1 = ActiveDocument.GetSheetObject("CH405")
Set obj2 = ActiveDocument.GetSheetObject("CH404")
Set obj3 = ActiveDocument.GetSheetObject("CH407")
Set obj4 = ActiveDocument.GetSheetObject("CH406")
Set obj5 = ActiveDocument.GetSheetObject("CH403")
Set obj6 = ActiveDocument.GetSheetObject("CH402")
Set obj7 = ActiveDocument.GetSheetObject("CH408")
Set XLSheet1 = XLDoc.Worksheets("Sheet1")
Set XLSheet2 = XLDoc.Worksheets("Sheet2")
Set XLSheet3 = XLDoc.Worksheets("Sheet3")
Set XLSheet4 = XLDoc.Worksheets("Sheet4")
Set rngStart1 = XLDoc.Sheets(1).Range("A2")
Set rngStart2 = XLDoc.Sheets(1).Range("A31")
Set rngStart3 = XLDoc.Sheets(2).Range("A2")
Set rngStart4 = XLDoc.Sheets(2).Range("A31")
Set rngStart5 = XLDoc.Sheets(3).Range("A2")
Set rngStart6 = XLDoc.Sheets(3).Range("A20")
Set rngStart7 = XLDoc.Sheets(4).Range("A2")
obj1.CopyTableToClipboard True
XLSheet1.Paste rngStart1
XLSheet1.Range("A1").Value = obj1.GetCaption.Name.v
Set title = XLSheet1.Range("A1")
XLDoc.Worksheets("Sheet1").Cells.Select
XLDoc.Worksheets("Sheet1").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet1").Cells.EntireColumn.AutoFit
obj2.CopyTableToClipboard True
XLSheet1.Paste rngStart2
XLSheet1.Range("A30").Value = obj2.GetCaption.Name.v
Set title = XLSheet1.Range("A30")
XLDoc.Worksheets("Sheet1").Cells.Select
XLDoc.Worksheets("Sheet1").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet1").Cells.EntireColumn.AutoFit
XLSheet1.Name = "Analytics leads report"
obj3.CopyTableToClipboard True
XLSheet2.Paste rngStart3
XLSheet2.Range("A1").Value = obj3.GetCaption.Name.v
Set title = XLSheet2.Range("A1")
XLDoc.Worksheets("Sheet2").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet2").Cells.EntireColumn.AutoFit
obj4.CopyTableToClipboard True
XLSheet2.Paste rngStart4
XLSheet2.Range("A30").Value = obj4.GetCaption.Name.v
Set title = XLSheet2.Range("A30")
XLDoc.Worksheets("Sheet2").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet2").Cells.EntireColumn.AutoFit
XLSheet2.Name = "Call-center leads report"
obj5.CopyTableToClipboard True
XLSheet3.Paste rngStart5
XLSheet3.Range("A1").Value = obj5.GetCaption.Name.v
Set title = XLSheet3.Range("A1")
XLDoc.Worksheets("Sheet3").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet3").Cells.EntireColumn.AutoFit
obj6.CopyTableToClipboard True
XLSheet3.Paste rngStart6
XLSheet3.Range("A19").Value = obj6.GetCaption.Name.v
Set title = XLSheet3.Range("A19")
XLDoc.Worksheets("Sheet3").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet3").Cells.EntireColumn.AutoFit
XLSheet3.Name = "E-approval leads report"
obj7.CopyTableToClipboard True
XLSheet4.Paste rngStart7
XLSheet4.Range("A1").Value = obj7.GetCaption.Name.v
Set title = XLSheet4.Range("A1")
XLDoc.Worksheets("Sheet4").Cells.EntireRow.RowHeight = 12.75
XLDoc.Worksheets("Sheet4").Cells.EntireColumn.AutoFit
XLSheet4.Name = "Email snapshot"
XLDoc.SaveAs FileName
XLApp.Quit
end function
Message was edited by: Kushal Chawda
Dear All,
I got the solution.
Actually while creating new Excel workbook default number of sheets are 3 , I have made default number to 4 sheets while creating new excel workbook and it worked.
Thanks !
Dear All,
I got the solution.
Actually while creating new Excel workbook default number of sheets are 3 , I have made default number to 4 sheets while creating new excel workbook and it worked.
Thanks !
Kushal M also getting the same issue bt confuesd where to make changes
sub ExcelFile
strDate = CDate(Date)
strDay = DatePart("d", strDate)
strMonth = DatePart("m", strDate)
strYear = DatePart("yyyy", strDate)
If strDay < 10 Then
strDay = "0" & strDay
End If
If strMonth < 10 Then
strMonth = "0" & strMonth
End If
GetFormattedDate = strMonth & "-" & strDay & "-" & strYear
Path = "C:\temp\"
FileName = "Test_" & GetFormattedDate & ".xlsx"
set XLApp = CreateObject("Excel.Application")
XLApp.Visible = true
set XLDoc = XLApp.Workbooks.Add
ActiveDocument.GetSheetObject("Page One").CopyTableToClipboard true
XLDoc.Sheets(1).Paste()
XLDoc.Sheets(1).Rows("1:3000").EntireRow.AutoFit
ActiveDocument.GetSheetObject("Page two").CopyTableToClipboard true
XLDoc.Sheets(2).Paste()
XLDoc.Sheets(2).Rows("1:3000").EntireRow.AutoFit
XLDoc.Sheets(1).Name = "Page One"
XLDoc.Sheets(2).Name = "Page Two"
XLDoc.Sheets(3).Delete
XLDoc.Sheets(1).Range("A1").Select
end sub