Copy from active workbook to new workbook.

[Ron]

Hello,

I need some help debugging my code.
From an opened excel spreadsheet I would like to determine the last row
that has data in it and copy that data to a new workbook.

The error I am receiving is in the code to copy and is as follows:
Run-time error ‘1004’: Application defined or object defined error.

Thanks for your time and advise.

Ron


Private Sub SaveData_Click()

Dim ExcelLastCell As Object
Dim LastRowWithData As String
Dim Row As String
Dim NewBook As Object


' Find last cell with data in starting at cell A10

Range("A10").Select

Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)

' Determine the last row with data in it

LastRowWithData = ExcelLastCell.Row
Row = ExcelLastCell.Row
Do While Application.CountA(ActiveSheet.Rows(Row)) = 0 And Row <> 1
Row = Row - 1
Loop
LastRowWithData = Row

' Create new workbook

Set NewBook = Workbooks.Add
With NewBook
..SaveAs Filename:="new.xls"
End With

' Copy selected cells from original workbook sheet 5 to sheet 1 of the
new workbook

Workbooks("original.xls").Worksheets("sheet
5").Range("A10:LastRowWithData").Copy _
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1")

End Sub

 

[mudraker]

Error in this code

Workbooks("original.xls").Worksheets("shee
5").Range("A10:LastRowWithData").Copy
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1")

should be

Workbooks("original.xls").Worksheets("sheet 5").Range("A10:"
LastRowWithData).Copy
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1")



Also if you have one column that has an entry in each row then
suggest you use


dim LastRowWithData
LastRowWithData = Range("a65536").End(xlUp).Row

' Create new workbook

Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:="new.xls"
End With


Workbooks("original.xls").Worksheets("sheet 5").Range("A10:"
LastRowWithData).Copy
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1"

 

[Tom Ogilvy]

suggested correction:
Workbooks("original.xls").Worksheets("sheet 5").Range("A10:" &
LastRowWithData).Copy _
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1")

has an error,
should be

Workbooks("original.xls").Worksheets("sheet 5").Range("A10:A" &
LastRowWithData).Copy _
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1")

LastRowWithData appears to be a string containing a row number (no column
letter)

 

[Ron]

Thanks mudraker and Tom for replies.

I am still experiencing problems. No errors, but the data is not copin
to new workbook.
My code is now:

Dim LastRowWithData
LastRowWithData = Range("a65536").End(xlUp).Row

Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:="new.xls"
End With

Workbooks("original.xls").Worksheets("Sheet 5").Range("A10:A" &
LastRowWithData).Copy _
Destination:=Workbooks("new.xls").Worksheets("Sheet1").Range("A1")

End Su

 

[Tom Ogilvy]

this is troublesome:
With NewBook
SaveAs Filename:="new.xls"
End With

should be

With NewBook
.SaveAs Filename:="new.xls"
End With

or
NewBook.SaveAs Filename:="New.xls"

I am not sure what the unqualified SAVEAS would referto.

Other than that, I don't see a problem with your code if you are not getting
any errors and you don't have errors suppressed.