Merging of Worksheets

H

hce

Dear All

Is it possible to merge say 3 worksheets of the same structure int
just 1 worksheet? If yes, how? I would really appreciate an
help/suggestion...

Thank
 
P

Paul B

Give this a try, I think the code was By: Ron de Bruin


'will take the data on all sheets in a workbook and copy it to one sheet
Public 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 test()
Dim sh As Worksheet
Dim last As Long
Dim rng As Range
Dim shLast As Long
Sheets.Add.Name = "Master"
Worksheets("Master").Cells.ClearContents
Worksheets("Master").Range("a1").Value = "All sheets"
For Each sh In ThisWorkbook.Worksheets
If UCase(sh.Name) <> "MASTER" Then
last = LastRow(Worksheets("Master"))
shLast = LastRow(sh)
Set rng = Worksheets("Master").Cells(last + 1, 1)
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy Destination:=rng
End If
Next
End Sub


--
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2000 & 97
** remove news from my email address to reply by email **
 
R

Ron de Bruin

You can find more info on this page
http://www.rondebruin.nl/copy2.htm

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


Paul B said:
Give this a try, I think the code was By: Ron de Bruin


'will take the data on all sheets in a workbook and copy it to one sheet
Public 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 test()
Dim sh As Worksheet
Dim last As Long
Dim rng As Range
Dim shLast As Long
Sheets.Add.Name = "Master"
Worksheets("Master").Cells.ClearContents
Worksheets("Master").Range("a1").Value = "All sheets"
For Each sh In ThisWorkbook.Worksheets
If UCase(sh.Name) <> "MASTER" Then
last = LastRow(Worksheets("Master"))
shLast = LastRow(sh)
Set rng = Worksheets("Master").Cells(last + 1, 1)
sh.Range(sh.Rows(1), sh.Rows(shLast)).Copy Destination:=rng
End If
Next
End Sub


--
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2000 & 97
** remove news from my email address to reply by email **
Click to expand...
 
Top