PDA

View Full Version : Combine Worksheets into One Master



Anne Troy
06-16-2004, 10:52 PM
Great procedure. Thanks, smozgur!

This macro takes the used range from all worksheets (we're assuming they all have the exact same layout) and combines them into a new worksheet called "Master".

I want to add it to our knowledgebase, but I think we ought to add a little message box that asks if the worksheets have heading rows, because most will, and then edit the code accordingly so that it doesn't pull the first row over in that case. Either that, or we make 2 KB entries, one for each scenario.

Here's the current code:


Sub CopyUsedRangeValues()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long

If SheetExists("Master") = True Then
MsgBox "A worksheet called Master already exists"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> DestSh.Name Then
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
With sh.UsedRange
DestSh.Cells(Last + 1, 1).Resize(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
End If

Next
Application.ScreenUpdating = True
End Sub

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

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean

On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(Sheets(SName).Name))
End Function

Current sample attached.

Zack Barresse
06-17-2004, 12:20 AM
Works good. :) I vote for 2 seperate entries ;)

roos01
06-19-2004, 01:15 AM
Hello Dreamboat,
I learned on an other forum from Brad that the sheetexist function would not work if the Error trapping in VBA is set to "break on all errors" (Tools>>Options>>General menu item) this function will return: #VALUE!
instead you might use a function simular like:


Function SheetExists(sname) As Boolean
' Returns TRUE if sheet exists in the active workbook
If IsError(Evaluate(sname & "!A1")) Then SheetExists = False _
Else SheetExists = True
End Function


you might even use "IV65536" instead A1 since it is not likely that someone has data in the "last" cell.

Ken Wright
06-19-2004, 11:09 AM
Here's a routine I use that does the same thing, but does indeed ask for the header row. It also introduces an extra column, and then tags every set of data from each sheet with that sheets name against. This means that you don't lose sight of the granularity that the sheetname gave you. makes it nice and easy to throw into a Pivot table that way.


Sub SummaryCombineMultipleSheets()
Dim SumWks As Worksheet
Dim sd As Worksheet
Dim sht As Long
Dim lrow1 As Long
Dim lrow2 As Long
Dim StRow As Long

HeadRow = InputBox("What row are the Sheet's data headers in?")
DataRow = HeadRow + 1

On Error Resume Next
Application.DisplayAlerts = False
Sheets("Summary Sheet").Delete
Application.DisplayAlerts = False
On Error GoTo 0

Set SumWks = Worksheets.Add

With SumWks
.Move Before:=Sheets(1)
.Name = "Summary Sheet"
Sheets(2).Rows(HeadRow).Copy .Range("1:1")
Columns("A:A").Insert Shift:=xlToRight
Range("A1").Value = "INDEX"
End With

With Sheets(2)
ColW = .UsedRange.Column - 1 + .UsedRange.Columns.Count
End With

For sht = 2 To ActiveWorkbook.Sheets.Count
Set sd = Sheets(sht)
lrow1 = SumWks.Cells(Rows.Count, "B").End(xlUp).Row
lrow2 = sd.Cells(Rows.Count, "B").End(xlUp).Row
sd.Activate
sd.Range(Cells(DataRow, 1), Cells(lrow2, ColW)).Copy SumWks.Cells(lrow1 + 1, 2)
SumWks.Cells(lrow1 + 1, 1).Resize(lrow2 - (DataRow - 1), 1).Value = sd.Name
Next sht

SumWks.Activate

End Sub




Regards
Ken......................

jackal_yap
10-29-2008, 02:12 AM
Hi ken,

How if i want to use the same code on other workbook?

Rgds,
Jackal