I think I did reset lCounter:

Set wksSheet1 = Workbooks(sDestBook).Worksheets(1)
lCounter = 0
For Each wksSheet2 In Workbooks(sSourceBook).Worksheets

guess you missed it.

But you are correct that the worksheets count should be compared to the
source workbook.

--
Regards,
Tom Ogilvy


"Kevin H. Stecyk" wrote in message
...
Hi Tom,

Thank you very much for all your help! I greatly appreciate you providing
the code. Not only did I get the answer that I needed, but I also got an
opportunity to increase my learning. I don't use VBA frequently enough to
always be conversant with it. But with you doing all the heavy lifting, I
was able to get my answer and increase my learning.

There were two small oversights that have been corrected. One was I reset
lCounter=0 and I switched books. The code is documented below. I also
added two small changes. One, I selected "A1" after the formulas and
formats were copied. Two, after the routine is finished I select the
first
sheet.

Again, thank you very much for all your help!

Best regards,
Kevin


The routine below copies the formulas and formats from all the sheets in
the
"Source" book to the "Destination" book. For those wanting to copy the
code, be careful of the line wrap.



Sub CopyFormulasFormats()

Dim wksSheet1 As Worksheet '\Destination workbook sheet
Dim wksSheet2 As Worksheet '\Source workbook sheet
Dim wksSheet3 As Worksheet '\Temp source workbook sheet
Dim wksSheet4 As Worksheet '\Destination Sheets for renaming
Dim lCounter As Long
Dim sSourceBook As String
Dim sDestBook As String


sSourceBook = "Source.xls" '\***You need to change this line***
sDestBook = "Destination.xls" '\***You need to change this line***

Application.ScreenUpdating = False

lCounter = 100
'\rename destination sheets with dummy names to
'\avoid duplicate sheet name problems
For Each wksSheet4 In Workbooks(sDestBook).Worksheets
wksSheet4.Name = "zxaabir" & lCounter
lCounter = lCounter + 1
Next wksSheet4

Set wksSheet1 = Workbooks(sDestBook).Worksheets(1)

lCounter = 0 '\New line

For Each wksSheet2 In Workbooks(sSourceBook).Worksheets
lCounter = lCounter + 1
wksSheet2.Cells.Copy
wksSheet1.Cells.PasteSpecial xlFormats
wksSheet1.Cells.PasteSpecial xlFormulas
wksSheet1.Cells(1, 1).Select '\New Line
wksSheet1.Name = wksSheet2.Name
wksSheet1.Tab.Color = wksSheet2.Tab.Color

If lCounter < Workbooks(sSourceBook).Worksheets.Count Then '\Switched
books
Set wksSheet3 = Nothing
On Error Resume Next
Set wksSheet3 = wksSheet1.Next
On Error GoTo 0

If Not wksSheet3 Is Nothing Then
Set wksSheet1 = wksSheet3
Else
Set wksSheet1 =
Worksheets.Add(After:=wksSheet1.Parent.Worksheets( _
wksSheet1.Parent.Worksheets.Count))
End If
End If
Next wksSheet2

Workbooks(sDestBook).Worksheets(1).Activate '\New Line

Application.ScreenUpdating = True

End Sub


Tom Ogilvy wrote...

I didn't bench test it, so there is always the chance of an oversight
such
as you pointed out.

The best approach would be not to add the sheet not needed. See
adjusted
code

Using color or colorindex is usually a matter of personal choice. If it
works, that should be sufficient.

Sub CopyFormulasFormats()

Dim wksSheet1 As Worksheet '\Destination workbook sheet
Dim wksSheet2 As Worksheet '\Source workbook sheet
Dim wksSheet3 As Worksheet '\Temp source workbook sheet
Dim wksSheet4 As Worksheet '\Destination Sheets for renaming
Dim lCounter As Long
Dim lTotalSheetsDest As Long
Dim sSourceBook As String
Dim sDestBook As String

sSourceBook = "Source.xls"
sDestBook = "Dest.xls"

lCounter = 100
'\rename destination sheets with dummy names to
'\avoid duplicate sheet name problems
For Each wksSheet4 In Workbooks(sDestBook).Worksheets
wksSheet4.Name = "zxaabir" & lCounter
lCounter = lCounter + 1
Next wksSheet4

Set wksSheet1 = Workbooks(sDestBook).Worksheets(1)
lCounter = 0
For Each wksSheet2 In Workbooks(sSourceBook).Worksheets
lCounter = lCounter + 1
wksSheet2.Cells.Copy
wksSheet1.Cells.PasteSpecial xlFormats
wksSheet1.Cells.PasteSpecial xlFormulas
wksSheet1.Name = wksSheet2.Name
wksSheet1.Tab.Color = wksSheet2.Tab.Color '\New Line

If lCounter < Workbooks(sDestBook).Worksheets.count then
Set wksSheet3 = Nothing
On Error Resume Next
Set wksSheet3 = wksSheet1.Next
On Error GoTo 0

If Not wksSheet3 Is Nothing Then
Set wksSheet1 = wksSheet3
Else
Set wksSheet1 =
Worksheets.Add(After:=wksSheet1.Parent.Worksheets( _
wksSheet1.Parent.Worksheets.Count))
End If
End If
Next wksSheet2

End Sub

Your approach to get the last worksheet is the way to do it:
'\New Line Below

Workbooks(sDestBook).Worksheets(Workbooks(sDestBoo k).Worksheets.Count).Delet
e

You can make it more compact using with (also suppress prompt )

With Workbooks(sDestBook)
Application.Displayalerts = False
.Worksheets(.Worksheets.count).Delete
Application.DisplayAlerts = True
End With

--
Regards,
Tom Ogilvy