LinkBack URL
About LinkBacksHi 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
Register To Reply
Bookmarks