Hello All,

Anytime I run the second macro which consists of setting page margins and
full path to my reports; indeed, it does execute my request and displays the
following error message €œType mismatch.€� I usually click OK to ignore it. Is
there anyone who can assist me in getting rid of this error message?


Const FirstRowWithTeamData = 2 ' row 1 is header row
Const TeamColumn = "E" ' column with team ID/Sheet names
Const SourceSheet = "Summary Page"
Const FirstColToCopy = "A"
Const LastColToCopy = "V"
'change to = "A:A,B:B,C:C,D:D,I:I,J:J,L:L,M:M,N:N,O:O,P:P,Q:Q,R :R"

Const ColumnsToHide =
"A:A,B:B,C:C,D:D,I:I,J:J,L:L,M:M,N:N,O:O,P:P,Q:Q,R :R"

Dim lastDataRow As Long
Dim destSheet As String ' hold name of destination sheeet
Dim destRow As Long ' row on dest sheet to put data into
Dim rowOffset As Long ' pointer to data
Dim whatToCopy As Range
Dim wheretoPaste As Range
Dim testPageValue As Variant 'use to test for page presence
Dim tempRange As Range ' for use during new sheet insertions
Dim LC As Integer ' Loop Counter used in .AutoFit loop
Dim anySheet As Worksheet ' added for v3 use
Dim lastRow As Long ' added for v3 use

'find last used row on Summary Page
lastDataRow = Worksheets(SourceSheet).Range(TeamColumn &
Rows.Count).End(xlUp).Row
'select Summary Page and cell at top of team list
Worksheets(SourceSheet).Select
Range(TeamColumn & "1").Select
'turn off screen updating for speed
Application.ScreenUpdating = False
For rowOffset = (FirstRowWithTeamData - 1) To lastDataRow - 1
'don't do anything if cell is empty
If Not IsEmpty(ActiveCell.Offset(rowOffset, 0)) Then
' create name of sheet to seek
destSheet = Trim(ActiveCell.Offset(rowOffset, 0))
If Len(destSheet) 0 Then ' have a name!
Set whatToCopy =
Worksheets(SourceSheet).Range(ActiveSheet.Range(Fi rstColToCopy & rowOffset +
1).Address & ":" & ActiveSheet.Range(LastColToCopy & rowOffset + 1).Address)
'test if destination sheet exists
On Error Resume Next
' any cell will do
testPageValue = Worksheets(destSheet).Range("A1")
If Err < 0 Then
'page does not exist, create it
Err.Clear
On Error GoTo 0
Worksheets.Add ' add sheet, it gets selected
'can fail if destSheet is not a valid sheet name!
ActiveSheet.Name = destSheet ' name it
Cells.Select
With Selection.Font
.Name = "Times New Roman"
.Size = 10
End With
Range("A2").Select
ActiveWindow.FreezePanes = False

'added to move header info to new sheets
Set tempRange =
Worksheets(SourceSheet).Range(FirstColToCopy & "1:" & LastColToCopy & "1")
Set wheretoPaste =
Worksheets(destSheet).Range(FirstColToCopy & "1:" & LastColToCopy & "1")
wheretoPaste.Value = tempRange.Value
'set up font bold, centered and width of columns
wheretoPaste.Font.Bold = True
wheretoPaste.HorizontalAlignment = xlCenter
wheretoPaste.VerticalAlignment = xlCenter
Range(FirstColToCopy & "1:" & LastColToCopy & "1").Select
Selection.Columns.AutoFit
Range("A1").Select
Worksheets(SourceSheet).Select ' back to proper sheet
End If
On Error GoTo 0
destRow = Worksheets(destSheet).Range(TeamColumn &
Rows.Count).End(xlUp).Row
If Not (IsEmpty(Worksheets(destSheet).Range(TeamColumn &
destRow))) Then
'only on new, or empty sheets
destRow = destRow + 1
End If
Set wheretoPaste =
Worksheets(destSheet).Range(Range(FirstColToCopy & destRow).Address & ":" &
Range(LastColToCopy & destRow).Address)
wheretoPaste.Value = whatToCopy.Value
End If ' test for sheet name
End If ' test for empty cell
Next ' rowOffset loop

For Each anySheet In ThisWorkbook.Worksheets
If anySheet.Name < SourceSheet Then
lastRow = anySheet.Range("A1").End(xlDown).Row
anySheet.Rows("1:" & lastRow).Columns.AutoFit
anySheet.Rows("1:" & lastRow).Rows.AutoFit
anySheet.Range("P1").ColumnWidth = 10

With anySheet.Range("A1:V" & lastRow)
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
anySheet.Range(ColumnsToHide).EntireColumn.Hidden = True
End If
Next
Worksheets(SourceSheet).Select
Application.ScreenUpdating = True
End Sub










----------------------------------------------------------------------------------

Public Sub PageSet()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.38)
.RightMargin = Application.InchesToPoints(0.39)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)


.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic
.CenterHeader = " "
.PrintErrors = xlPrintErrorsDisplayed
End With
Next ws
End Sub

__________________________________________________ _________

Public Sub DoFullPath()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup
' .CenterHeader = ActiveWorkbook.Name & _
'vbLf & ActiveSheet.Name

.CenterHeader = ActiveWorkbook.Name & _
vbLf & ws.Name

'ActiveSheet.PageSetup.CenterHeader = ActiveWorkbook.Name & _
vbLf & ActiveSheet.Name
End With
Next ws


Thanks,