как вариант  
пробежать по всем ws  
для каждой cell  в usedrange сооздать строку, описывающую ее форматирование    
и с помощью nodupes() записывать в коллекцию только уникальные

почти все описал:  
Sub Макрос2()  
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone  
   Selection.Borders(xlDiagonalUp).LineStyle = xlNone  
   With Selection.Borders(xlEdgeLeft)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeTop)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeBottom)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeRight)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Interior  
       .ColorIndex = 41  
       .Pattern = xlSolid  
       .PatternColorIndex = xlAutomatic  
   End With  
   Selection.Locked = False  
   Selection.FormulaHidden = False  
   With Selection  
       .HorizontalAlignment = xlLeft  
       .VerticalAlignment = xlJustify  
       .WrapText = True  
       .Orientation = 0  
       .AddIndent = False  
       .IndentLevel = 0  
       .ShrinkToFit = False  
       .ReadingOrder = xlContext  
       .MergeCells = False  
   End With  
   With Selection.Font  
       .Name = "Adobe Caslon Pro"  
       .FontStyle = "курсив"  
       .Size = 10  
       .Strikethrough = False  
       .Superscript = False  
       .Subscript = False  
       .OutlineFont = False  
       .Shadow = False  
       .Underline = xlUnderlineStyleDouble  
       .ColorIndex = 46  
   End With  
 
   With Selection.Borders(xlDiagonalDown)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlDiagonalUp)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeLeft)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeTop)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeBottom)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
   With Selection.Borders(xlEdgeRight)  
       .LineStyle = xlContinuous  
       .Weight = xlThin  
       .ColorIndex = xlAutomatic  
   End With  
End Sub  
все значения в строку через &  
только зачем?

sva, количество стилей - это другое. Я запустил проверку в своем файле (в котором количество форматов близко к переполнению - под 4000), количество стилей было 112. А когда в в этом же файле добавляешь еще несколько форматированных ячеек, то сразу сообщение "Слишком много форматов".  
 
С другой стороны - ведь файл Excel хранит где-то в своих недрах информацию о количестве использованных форматов, иначе как определяется момент переполнения форматов? Вот бы понять, где и как достать...:)  
 
Alex_ST  
Имеются в виду все возможные сочетания форматов ячеек - все те свойства, что описаны в сообщении от 16:52.  
 
Спасибо, 16:52 (увы, не знаю Вашего ника:), различие форматов понял. Вы имеете в виду, что нужно создать строку определенной длины типа String для каждой ячейки из usedrange, где каждый знак означает свойство одного из видов формата?

Вот так можно посчитать часть форматов, по аналогии можно еще сделать.  
Sub get_formats()  
Dim ws As Worksheet, cel As Range  
Dim oCI As Object, oCT As Object  
 
Set oCI = CreateObject("scripting.dictionary")  
Set oCT = CreateObject("scripting.dictionary")  
 
For Each ws In Worksheets  
   For Each cel In ws.UsedRange  
       If cel.Interior.ColorIndex <> xlNone Then 'цвет заливки  
           If Not oCI.exists(cel.Interior.ColorIndex) Then oCI.Add (cel.Interior.ColorIndex), 1  
       ElseIf cel.Font.ColorIndex <> xlNone Then 'цвет шрифта  
           If Not oCT.exists(cel.Font.ColorIndex) Then oCT.Add (cel.Font.ColorIndex), 1  
       End If  
   Next  
Next  
MsgBox oCI.Count + oCT.Count  
Set oCI = Nothing: Set oCT = Nothing  
 
End Sub

{quote}{login=Alex_ST}{date=02.03.2011 10:22}{thema=}{post} если форматы - это ВСЁ, что копируется при формате по образцу{/post}{/quote}  
А так оно и есть. Я и говорю - всё, наверное, и не предусмотреть. Разве, что "подсмотреть" каким-то образом у самого Excel :-)

Уважаемый The_Prist!  
Не подскажете, а как в Excel 2007 посмотреть количество форматов?  
Я попробовал сделать так - свой проблемный файл (последний, в котором еще не наступило переполнение форматов) сохранил в формате Excel 2007, дал ему расширение zip и распаковал. Нашел файл styles.xml и в нем увидел следующее:  
numFmts count      15  
fonts count     149  
fills count      38  
borders count     137  
cellStyleXfs count   627  
cellXfs count    2204  
cellStyles count     627  
dxfs count      96  
Общее количество форматов равно 3893, т.е. близко к критическим 4000.  
Так правильно?