Create master sheet RETAIN formats



I have this code, which is supposed to create a "Master"
sheet which will contain all of the information in the
other sheets in the file. The problem is...I need for
the formatting to be retained and placed in the "Master"

In other words, if the "NO BOMS" sheet has cell C1
highlighted with blue, I need for that same value in C1
to be blue in the "Master" sheet.

Here's the code (by Chip Pearson)

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

Sub Test5_Values()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long
If SheetExists("Master") = True Then
MsgBox "The sheet Master already exists...first
DELETE the Master sheet!"
Exit Sub
End If
Application.ScreenUpdating = False
Set DestSh = Worksheets.Add
DestSh.Name = "Master"
For Each sh In Sheets(Array("NO STOCK", ">
$2K", "$500-$2K", "$200-$500", "< $200", "NO BOMS"))
' For Each sh In ThisWorkbook.Worksheets
If sh.UsedRange.Count > 1 Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
With sh.Range(sh.Rows(2), sh.Rows(shLast))
DestSh.Cells(Last + 1, 1).Resize
(.Rows.Count, _
.Columns.Count).Value = .Value
End With
End If
Application.ScreenUpdating = True
End Sub





Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question