Hi all there,

I try to run the macro provided by Ron de Bruin
(http://www.rondebruin.nl/copy2.htm#rows), but it works only if attached to
the workbook with the data. If I put the macro to the Personal.xls, it stops
working, giving me the following message:

Run-time error '1004':
Application-defined or object-defined error

at the line:
= sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A")

At the beginning I just thought that the problem will be resolved if I
change "ThisWorksheet" to "ActiveWorksheet", but apparently the problem is
somewhere else.
Just in case, I post below the whole code.
Many thanks for any hints from your side!!

--------------

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

Sub Test5()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

On Error Resume Next
If Len(ActiveWorkbook.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)
shLast = LastRow(sh)

sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last
+ 1, "A")

End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

-----------------

markx

Try changing

For Each sh In ThisWorkbook.Worksheets

to
For Each sh In ActiveWorkbook.Worksheets


--

HTH

RP
(remove nothere from the email address if mailing direct)


"markx" wrote in message
...
Hi all there,

I try to run the macro provided by Ron de Bruin
(http://www.rondebruin.nl/copy2.htm#rows), but it works only if attached
to
the workbook with the data. If I put the macro to the Personal.xls, it
stops
working, giving me the following message:

Run-time error '1004':
Application-defined or object-defined error

at the line:
= sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A")

At the beginning I just thought that the problem will be resolved if I
change "ThisWorksheet" to "ActiveWorksheet", but apparently the problem is
somewhere else.
Just in case, I post below the whole code.
Many thanks for any hints from your side!!

--------------

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

Sub Test5()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

On Error Resume Next
If Len(ActiveWorkbook.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)
shLast = LastRow(sh)

sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy
DestSh.Cells(Last
+ 1, "A")

End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

-----------------

markx

Hi Bob/Mark

I add a note on the webpage about this



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



"Bob Phillips" wrote in message ...
Try changing

For Each sh In ThisWorkbook.Worksheets

to
For Each sh In ActiveWorkbook.Worksheets


--

HTH

RP
(remove nothere from the email address if mailing direct)


"markx" wrote in message
...
Hi all there,

I try to run the macro provided by Ron de Bruin
(http://www.rondebruin.nl/copy2.htm#rows), but it works only if attached
to
the workbook with the data. If I put the macro to the Personal.xls, it
stops
working, giving me the following message:

Run-time error '1004':
Application-defined or object-defined error

at the line:
= sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last + 1, "A")

At the beginning I just thought that the problem will be resolved if I
change "ThisWorksheet" to "ActiveWorksheet", but apparently the problem is
somewhere else.
Just in case, I post below the whole code.
Many thanks for any hints from your side!!

--------------

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

Sub Test5()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

On Error Resume Next
If Len(ActiveWorkbook.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)
shLast = LastRow(sh)

sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy
DestSh.Cells(Last
+ 1, "A")

End If
Next
Cells(1).Select
Application.ScreenUpdating = True
Else
MsgBox "The sheet Master already exist"
End If
End Sub

-----------------

markx