ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   Ron de Bruin Copy2 Macro - troubleshooting (https://www.excelbanter.com/excel-worksheet-functions/9383-ron-de-bruin-copy2-macro-troubleshooting.html)

gizmo

Ron de Bruin Copy2 Macro - troubleshooting
 
Hi guys,

I've looked for a macro that could merge all the worksheets (range) from the
open workbook into one new sheet.
Surfing through newsgroup archives, I've found several links to the
following page of Ron

http://www.rondebruin.nl/copy2.htm

with several excellent exemples. However, they seem not to work for me.
Here's the exact code I've put under Alt+F11

----
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

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, "A")
DestSh.Cells(Last + 1, "D").Value = sh.Name
End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

----

What I get is just the name "Sheet1" in D1 (even if there is no such name in
the whole workbook).
Maybe this is due to the fact that I registered this macro in "Personal.xls"
(in order to keep the macro accessible for all workbooks)... But the
"Master" sheet is created in the "normal" data workbook, so there is
something I don't understand.

Do you have any idea how to get out of this?

Thanks a lot for any suggestion!
Gizmo



Bob Phillips

You correctly identified the problem as putting the function in the
Personal.xls.

To overcome your problem, change the line

For Each sh In ThisWorkbook.Worksheets

to
For Each sh In ActiveWorkbook.Worksheets


--
HTH

Bob Phillips

"gizmo" wrote in message
...
Hi guys,

I've looked for a macro that could merge all the worksheets (range) from

the
open workbook into one new sheet.
Surfing through newsgroup archives, I've found several links to the
following page of Ron

http://www.rondebruin.nl/copy2.htm

with several excellent exemples. However, they seem not to work for me.
Here's the exact code I've put under Alt+F11

----
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

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, "A")
DestSh.Cells(Last + 1, "D").Value = sh.Name
End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

----

What I get is just the name "Sheet1" in D1 (even if there is no such name

in
the whole workbook).
Maybe this is due to the fact that I registered this macro in

"Personal.xls"
(in order to keep the macro accessible for all workbooks)... But the
"Master" sheet is created in the "normal" data workbook, so there is
something I don't understand.

Do you have any idea how to get out of this?

Thanks a lot for any suggestion!
Gizmo





gizmo

Thanks for your hint Bob!
It's working perfectly now!
Cheers,
Gizmo

"Bob Phillips" wrote in message
...
You correctly identified the problem as putting the function in the
Personal.xls.

To overcome your problem, change the line

For Each sh In ThisWorkbook.Worksheets

to
For Each sh In ActiveWorkbook.Worksheets


--
HTH

Bob Phillips

"gizmo" wrote in message
...
Hi guys,

I've looked for a macro that could merge all the worksheets (range) from

the
open workbook into one new sheet.
Surfing through newsgroup archives, I've found several links to the
following page of Ron

http://www.rondebruin.nl/copy2.htm

with several excellent exemples. However, they seem not to work for me.
Here's the exact code I've put under Alt+F11

----
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

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, "A")
DestSh.Cells(Last + 1, "D").Value = sh.Name
End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

----

What I get is just the name "Sheet1" in D1 (even if there is no such

name
in
the whole workbook).
Maybe this is due to the fact that I registered this macro in

"Personal.xls"
(in order to keep the macro accessible for all workbooks)... But the
"Master" sheet is created in the "normal" data workbook, so there is
something I don't understand.

Do you have any idea how to get out of this?

Thanks a lot for any suggestion!
Gizmo







Ron de Bruin

Hi gizmo

I will add a note about this on the webpage soon

--
Regards Ron de Bruin
http://www.rondebruin.nl



"gizmo" wrote in message ...
Thanks for your hint Bob!
It's working perfectly now!
Cheers,
Gizmo

"Bob Phillips" wrote in message
...
You correctly identified the problem as putting the function in the
Personal.xls.

To overcome your problem, change the line

For Each sh In ThisWorkbook.Worksheets

to
For Each sh In ActiveWorkbook.Worksheets


--
HTH

Bob Phillips

"gizmo" wrote in message
...
Hi guys,

I've looked for a macro that could merge all the worksheets (range) from

the
open workbook into one new sheet.
Surfing through newsgroup archives, I've found several links to the
following page of Ron

http://www.rondebruin.nl/copy2.htm

with several excellent exemples. However, they seem not to work for me.
Here's the exact code I've put under Alt+F11

----
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

Sub Test1()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

On Error Resume Next
If Len(ThisWorkbook.Worksheets.Item("Master").Name) = 0 Then
On Error GoTo 0
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
sh.Range("A1:C5").Copy DestSh.Cells(Last + 1, "A")
DestSh.Cells(Last + 1, "D").Value = sh.Name
End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

----

What I get is just the name "Sheet1" in D1 (even if there is no such

name
in
the whole workbook).
Maybe this is due to the fact that I registered this macro in

"Personal.xls"
(in order to keep the macro accessible for all workbooks)... But the
"Master" sheet is created in the "normal" data workbook, so there is
something I don't understand.

Do you have any idea how to get out of this?

Thanks a lot for any suggestion!
Gizmo










All times are GMT +1. The time now is 01:07 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com