как-то так, наверное
[vba]Код
Sub u_611()
Application.ScreenUpdating = False
a = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row
Sheets("ИТОГ").Range("a1:f" & a).Clear
b = Sheets("База").Cells(Rows.Count, "a").End(xlUp).Row
For c = 2 To b
d = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Row + 1
e = Sheets("ИТОГ").Cells(Rows.Count, "a").End(xlUp).Value
If e = "" Then d = 1
f = Sheets("База").Range("a" & c).Value
g = Sheets("База").Range("b" & c).Value
h = f & " Код:" & g
Sheets("ИТОГ").Range("a" & d & ":f" & d).Merge
Sheets("ИТОГ").Range("a" & d & ":f" & d).HorizontalAlignment = xlCenter
Sheets("ИТОГ").Range("a" & d & ":f" & d).Borders.LineStyle = True
Sheets("ИТОГ").Range("a" & d) = h
i = Sheets("База").Range("c" & c).Value
j = Application.Match(i, Sheets("Свойства").Range("a:a"), 0)
If IsNumeric(j) Then
k = Application.CountIf(Sheets("Свойства").Range("a:a"), i)
l = k + j - 1
Sheets("Свойства").Range("b" & j & ":g" & l).Copy Sheets("ИТОГ").Range("a" & d + 1)
End If
Next
Application.ScreenUpdating = True
End Sub
[/vba]