copy to another wb and name the target sheet (XL2000)

[robert burger]

Good morning all,
I found the following two codes and am having trouble making them both
work together.
The Sub_copy_to_another_workbook works great on its own but when i add
the option of naming the target worksheet it doesn't work.
Any suggestions?

thanks,
Robert

Sub copy_to_another_workbook()

Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim destSheet As Worksheet
Dim wksName As String

Application.ScreenUpdating = False

If bIsBookOpen("test_target.xls") Then
Set destWB = Workbooks("test_target.xls")
Else
Set destWB = Workbooks.Open("C:\Documents and
Settings\target.xls")
End If

With ActiveWorkbook
wksName = Application.InputBox(prompt:="Copy to what sheet:
", Type:=2)
Set destSheet = .Sheet(wksName)
End With

Lr = LastRow(destWB.Sheets("wksname")) + 1
Set sourceRange = ThisWorkbook.Sheets("DATA_TEST").Range("A1:C10")
Set destrange = destWB.Sheets("wksname").Range("A" & Lr)

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean

On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function Lastcol(sh As Worksheet)
On Error Resume Next
Lastcol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Bernie Deitrick]

Robert,

What exactly doesn't work? and how are you adding the option of naming the
target worksheet?

HTH,
Bernie
MS Excel MVP

 

[Ron de Bruin]

Hi Robert

I see you are using

test_target.xls
and
target.xls

Both must be the same


Try this (I have not test the sub)

Sub copy_to_another_workbook()
Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim destSheet As String
Dim wksName As Variant

Application.ScreenUpdating = False

If bIsBookOpen("test_target.xls") Then
Set destWB = Workbooks("test_target.xls")
Else
Set destWB = Workbooks.Open("C:\Documents and Settings\test_target.xls")
End If

wksName = Application.InputBox(prompt:="Copy to what sheet:", Type:=2)
If wksName = False Then
'do nothing
Else
On Error GoTo eind
Lr = LastRow(destWB.Sheets(wksName)) + 1
Set sourceRange = ThisWorkbook.Sheets("DATA_TEST").Range("A1:C10")
Set destrange = destWB.Sheets(wksName).Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
End If
Exit Sub
eind:
Application.ScreenUpdating = True
End Sub

 

[robert burger]

Thanks for the reply Ron de Bruin and Bernie,
I want to apologize for not being clear on my first post.

Ron de Bruin,
I thought that my code would allow me to name the target but instead (i
think)it allows me to choose the target worksheet.
Currently, with the sub below, I run the macro I get the Inputbox, I
give it a name but when I check the target there is no data and no name
on the sheet.

Bernie,
I hope this answers your questions.

thanks,
Robert

Sub copy_to_another_workbook()

Dim sourceRange As Range
Dim destrange As Range
Dim destWB As Workbook
Dim Lr As Long
Dim destSheet As String
Dim wksName As String

Application.ScreenUpdating = False

If bIsBookOpen("test_target.xls") Then
Set destWB = Workbooks("test_target.xls")
Else
Set destWB = Workbooks.Open("C:\Documents and
Settings\test_target.xls")
End If
wksName = Application.InputBox(prompt:="Copy to what sheet: ",
Type:=2)

If wksName = flase Then
'do nothing
Else
On Error GoTo eind

Lr = LastRow(destWB.Sheets("wksname")) + 1
Set sourceRange =
ThisWorkbook.Sheets("DATA_TEST").Range("A1:C10")
Set destrange = destWB.Sheets("wksName").Range("A" & Lr)
sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
destWB.Close True
Application.ScreenUpdating = True
End If
Exit Sub
eind:
Application.ScreenUpdating = True
End Sub

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

Hi Robert

Do you want to copy the cells on a new sheet and give it a name?.
In my example you must fill in a existing sheet.name

 

[robert burger]

Ron de Bruin,
yes i want copy the source sheet range and paste it in a target sheet
and give that target sheet a name.

Come to think of it, I guess it's not really a target but a new sheet
since a target would already have a name?

Robert

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Ron de Bruin]

Use this then

Sub copy_to_another_workbook()

Dim sourceRange As Range
Dim destSheet As Worksheet
Dim destrange As Range
Dim destWB As Workbook
Dim wksName As Variant

Application.ScreenUpdating = False

If bIsBookOpen("test_target.xls") Then
Set destWB = Workbooks("test_target.xls")
Else
Set destWB = Workbooks.Open("C:\Documents and Settings\test_target.xls")
End If

wksName = Application.InputBox(prompt:="Copy to what sheet:", Type:=2)
If wksName = False Then
'do nothing
Else
Set sourceRange = ThisWorkbook.Sheets("DATA_TEST").Range("A1:C10")

On Error Resume Next
Set destSheet = destWB.Worksheets.Add
destSheet.Name = wksName
On Error GoTo 0
Set destrange = destSheet.Range("A1")

sourceRange.Copy
destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
'destWB.Close True
End If

Application.ScreenUpdating = True
End Sub

 

[robert burger]

Ron de Bruin,
Thank you very much. Your code works perfectly!
have a great weekend!

Robert.

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!