Copy and Paste Problem

  • Thread starter Thread starter Ronald W. Roberts
  • Start date Start date
R

Ronald W. Roberts

Below is some code I'm trying to get to copy a worksheet from one workbook
and add it to the end of a worksheet in another workbook.



The problem I'm having is in the paste. Windows or Office, not sure which,
gets into a loop display a message saying it can do the paste because the
system, or workbook is busy. I can give you the complete message because you
can't see the full message when it is displayed.



When I end the program, 2 strange things happen, 1) the worksheet I copied
is now in a workbook called Book1.xls which I didn't open a new workbook in
the program and 2) what ever I copied, that's programming code or comments,
in the process of changing the program before I run a test, sometimes that
is pasted at the last row of the workbook I want to append the data to.



This is an Access program so I'm not sure which NewsGroup to post to Access
or Excel, so I did both.

Any ideas or comments will be greatly appreciated.



Thanks,



Ron



Dim xlApp As Excel.Application

Dim xlwbBook As Excel.Workbook

Dim xlwsSheet As Excel.Worksheet



Dim xlwbBookWrk As Excel.Workbook

Dim xlwsSheetWrk As Excel.Worksheet



Dim xlAddress As String

Dim LastRow As Long

Dim LastRowWrk As Long



Set xlApp = New Excel.Application

Set xlwbBook = xlApp.Workbooks.Open(cInPutFileName)

xlwbBook.SaveAs (cOutPutFileName)



'Find select the last row

'-------------------------------

Set xlwsSheet = xlwbBook.Worksheets("Order Report")

xlwsSheet.Activate

LastRow = xlwsSheet.UsedRange.Rows.Count + 1

xlAddress = LastRow & ":" & LastRow

xlwsSheet.Rows(xlAddress).Select



'Get the second workbook

'find the last row

'Select the data from row 1 thru the last row

'----------------------------------------------------------

Set xlwbBookWrk = xlApp.Workbooks.Open(cInPutFileName)

Set xlwsSheetWrk = xlwbBookWrk.Worksheets("Order Report")

LastRowWrk = xlwsSheetWrk.UsedRange.Rows.Count + 1

xlAddress = "1:" & LastRowWrk

xlwsSheetWrk.Rows(xlAddress).Select

xlwsSheetWrk.Copy



'Switch back to the first workbook/worksheet

'------------------------------------------------------

xlwsSheet.Activate

xlwsSheet.Paste

xlApp.CutCopyMode = False

xlwsSheet.Range("A1").Select

xlwbBookWrk.CLOSE



xlwbBook.Save

xlwbBook.CLOSE

xlApp.Quit
 
when you copy a worksheet if you don't use BEFORE or AFTER excel
automatically creates a new workbook

from
xlwsSheetWrk.Copy

to
with xlwbBookWrk
xlwsSheetWrk.Copy after:=.sheets(.sheets.count)
end with

which will add the new sheet as the last sheet
 
Here are some changes that I would use

Dim xlApp As Excel.Application

Dim xlwbBook As Excel.Workbook

Dim xlwsSheet As Excel.Worksheet



Dim xlwbBookWrk As Excel.Workbook

Dim xlwsSheetWrk As Excel.Worksheet



Dim xlAddress As String

Dim LastRow As Long

Dim LastRowWrk As Long



Set xlApp = New Excel.Application

Set xlwbBook = xlApp.Workbooks.Open(cInPutFileName)

xlwbBook.SaveAs (cOutPutFileName)



'Find select the last row

'-------------------------------

Set xlwsSheet = xlwbBook.Worksheets("Order Report")


'----------------Theses rows do nothing ------------------------------------
'xlwsSheet.Activate

'LastRow = xlwsSheet.UsedRange.Rows.Count + 1

'xlAddress = LastRow & ":" & LastRow

set PasteRange = xlwsSheet.Rows(xlAddress)

Set xlwbBookWrk = xlApp.Workbooks.Open(cInPutFileName)

Set xlwsSheetWrk = xlwbBookWrk.Worksheets("Order Report")

LastRowWrk = xlwsSheetWrk.UsedRange.Rows.Count + 1

xlAddress = "1:" & LastRowWrk

set CopyRange = xlwsSheetWrk.Rows(xlAddress)

CopyRange.Copy destination:=PasteRange


xlwbBookWrk.CLOSE

xlwbBook.Save

xlwbBook.CLOSE

xlApp.Quit
 
Thanks, I'll give it a try.

Ron
Joel said:
Here are some changes that I would use

Dim xlApp As Excel.Application

Dim xlwbBook As Excel.Workbook

Dim xlwsSheet As Excel.Worksheet



Dim xlwbBookWrk As Excel.Workbook

Dim xlwsSheetWrk As Excel.Worksheet



Dim xlAddress As String

Dim LastRow As Long

Dim LastRowWrk As Long



Set xlApp = New Excel.Application

Set xlwbBook = xlApp.Workbooks.Open(cInPutFileName)

xlwbBook.SaveAs (cOutPutFileName)



'Find select the last row

'-------------------------------

Set xlwsSheet = xlwbBook.Worksheets("Order Report")


'----------------Theses rows do
nothing ------------------------------------
'xlwsSheet.Activate

'LastRow = xlwsSheet.UsedRange.Rows.Count + 1

'xlAddress = LastRow & ":" & LastRow

set PasteRange = xlwsSheet.Rows(xlAddress)

Set xlwbBookWrk = xlApp.Workbooks.Open(cInPutFileName)

Set xlwsSheetWrk = xlwbBookWrk.Worksheets("Order Report")

LastRowWrk = xlwsSheetWrk.UsedRange.Rows.Count + 1

xlAddress = "1:" & LastRowWrk

set CopyRange = xlwsSheetWrk.Rows(xlAddress)

CopyRange.Copy destination:=PasteRange


xlwbBookWrk.CLOSE

xlwbBook.Save

xlwbBook.CLOSE

xlApp.Quit
Click to expand...
 
Back
Top