VB6 EXCEL PROBLEM

Zam Zam · August 18th, 2010, 04:13 AM

Hi Shansur,

this is the line
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")

by the way actually wad i want is for me to determine the number of workbook
eg in a consist of 101 lines and a header
when i input 30 lines then it will create 4 new workbook
b consist of 2-30 lines
c next 31-60 lines
d next 61 - 90 lines
e remaining 91 - 100 lines

and each b,c,d,e will consist of the header from original workbook a. i want the data remain the same as it is in the original workbook a.

can help me out?

Shasur · August 18th, 2010, 04:23 AM

Hi

Can you check it the objects (OWS and Ocopy) have some values

You can call

oWS.Range("A1").Copy oCopy.Range("A1")

and check if the values are OK

Zam Zam · August 18th, 2010, 04:31 AM

Hi Shasur,

it prompt me with the error "Copy method of Range class failed"

and it shows no value in the object

regards

Shasur · August 18th, 2010, 04:45 AM

Hi

Can you post the full code so that I can test it

Cheers
Shasur

Zam Zam · August 18th, 2010, 04:51 AM

Hi Shasur,

Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(txtFilepath.Text)

Dim oWS As Worksheet
Dim oWB As Workbook
Dim iMaxRow As Long
Dim iHalfRow As Long
Dim oCopy As Worksheet
Set oWS = wb.Worksheets(1)
iMaxRow = oWS.Cells.SpecialCells(xlCellTypeLastCell).Row
iHalfRow = iMaxRow / 2
Set oWB = Workbooks.Add
Set oCopy = oWB.Sheets(1)
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")
oWS.Range("A2", "Z" & CStr(iHalfRow)).EntireRow.Copy oCopy.Range("A2")
oWB.SaveAs "c:\Test\b.xls"
oWB.Close False
Set oWB = Workbooks.Add
Set oCopy = oWB.Sheets(1)
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")
oWS.Range("A" & CStr(iHalfRow + 1), "Z" & CStr(iMaxRow)).EntireRow.Copy oCopy.Range("A2")
oWB.SaveAs "c:\Test\c.xls"
oWB.Close False

Shasur · August 19th, 2010, 12:50 AM

Hi

Can you try with this

Code:

Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(txtFilepath.Text)

Dim oWS As Worksheet
Dim oWB As Workbook
Dim iMaxRow As Long
Dim iHalfRow As Long
Dim oCopy As Worksheet
Set oWS = wb.Worksheets(1)
iMaxRow = oWS.Cells.SpecialCells(xlCellTypeLastCell).Row
iHalfRow = iMaxRow / 2
Set oWB = xlApp.Workbook.Add
Set oCopy = oWB.Sheets(1)
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")
oWS.Range("A2", "Z" & CStr(iHalfRow)).EntireRow.Copy oCopy.Range("A2")
oWB.SaveAs "c:\Test\b.xls"
oWB.Close False
Set oWB = xlApp.Workbooks.Add
Set oCopy = oWB.Sheets(1)
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")
oWS.Range("A" & CStr(iHalfRow + 1), "Z" & CStr(iMaxRow)).EntireRow.Copy oCopy.Range("A2")
oWB.SaveAs "c:\Test\c.xls"
oWB.Close False

Cheers
Shasur

Zam Zam · August 19th, 2010, 03:03 AM

Hi Shasur,

The line below give me the error message. anything missing here?

Set oWB = xlApp.Workbook.Add <-----"object do not support this property or method"

here is my full code:

Code:

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(txtFilepath.Text)
Dim oWS As Worksheet
Dim oWB As Workbook
Dim iMaxRow As Long
Dim iHalfRow As Long
Dim oCopy As Worksheet
Set oWS = wb.Worksheets(1)
iMaxRow = oWS.Cells.SpecialCells(xlCellTypeLastCell).Row
iHalfRow = iMaxRow / 2
Set oWB = xlApp.Workbook.Add
Set oCopy = oWB.Sheets(1)
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")
oWS.Range("A2", "Z" & CStr(iHalfRow)).EntireRow.Copy oCopy.Range("A2")
oWB.SaveAs "c:\Test\b.xls"
oWB.Close False
Set oWB = xlApp.Workbooks.Add
Set oCopy = oWB.Sheets(1)
oWS.Rows(1).EntireRow.Copy oCopy.Range("A1")
oWS.Range("A" & CStr(iHalfRow + 1), "Z" & CStr(iMaxRow)).EntireRow.Copy oCopy.Range("A2")
oWB.SaveAs "c:\Test\c.xls"
oWB.Close False

Shasur · August 19th, 2010, 03:14 AM

Sorry it was a typo

It should be

oWB = xlApp.Workbooks.Add

Cheers
Shasur

Zam Zam · August 19th, 2010, 03:50 AM

Hi Shasur,

Still the same error after removing the

Set oWB = xlApp.Workbook.Add

to

oWB = xlApp.Workbook.Add

Shasur · August 19th, 2010, 04:56 AM

Hi

IT should be

Set oWB = oXlapp.Workbooks.add

Cheers
Shasur