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"
sheet.

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

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
Next
Application.ScreenUpdating = True
End Sub

Thanks,
Brenda

Create master sheet RETAIN formats
 

Hi Brenda

You must use the Sub Test5() example
This will do a normal copy
http://www.rondebruin.nl/copy2.htm

--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2002 SP-2)
www.rondebruin.nl



"Brenda" wrote in message ...
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"
sheet.

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

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
Next
Application.ScreenUpdating = True
End Sub

Thanks,
Brenda

Create master sheet RETAIN formats
 

Thanks Ron...I appreciate it!

Brenda

-----Original Message-----
Hi Brenda

You must use the Sub Test5() example
This will do a normal copy
http://www.rondebruin.nl/copy2.htm

--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2002 SP-2)
www.rondebruin.nl



"Brenda" wrote in
message ...
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"
sheet.

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

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
Next
Application.ScreenUpdating = True
End Sub

Thanks,
Brenda


.