[Iska]

dyshes90, мой вариант извлечения — посредством OLE DB (Office 2003):

Код:

Sub Sample()
    Dim objConnection As Object
    Dim objRecordSet1 As Object
    Dim objRecordSet2 As Object
    
    Dim objCurRegion As Range
    
    
    Set objConnection = CreateObject("ADODB.Connection")
    
    With objConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = _
            "Data Source=" & ThisWorkbook.FullName & ";" & _
            "Extended Properties=""Excel 8.0;HDR=Yes;"""
        .Open
    End With
    
    Set objCurRegion = ThisWorkbook.Worksheets.Item("Адресная программа").Range("B2").CurrentRegion
    
    Set objRecordSet1 = objConnection.Execute( _
            "SELECT DISTINCT Наименование " & _
            "FROM [Адресная программа$" & objCurRegion.Address(False, False) & "] " & _
            "WHERE NOT Наименование IS NULL ORDER BY Наименование" _
        )
    
    Set objRecordSet2 = objConnection.Execute( _
            "SELECT Наименование, Ячейки, Количество " & _
            "FROM [Адресная программа$" & objCurRegion.Address(False, False) & "] " & _
            "WHERE NOT Наименование IS NULL ORDER BY Наименование, Ячейки" _
        )
    
    Do Until objRecordSet1.EOF
        Debug.Print objRecordSet1.Fields.Item("Наименование").Value
        
        With objRecordSet2
            .Filter = "Наименование='" & objRecordSet1.Fields.Item("Наименование").Value & "'"
            
            Do Until .EOF
                With .Fields
                    Debug.Print vbTab, .Item("Ячейки").Value, vbTab, .Item("Количество").Value
                End With
                
                .MoveNext
            Loop
        End With
        
        objRecordSet1.MoveNext
    Loop
    
    Set objCurRegion = Nothing
    
    objRecordSet2.Close
    objRecordSet1.Close
    
    objConnection.Close
    
    Set objRecordSet2 = Nothing
    Set objRecordSet1 = Nothing
    
    Set objConnection = Nothing
End Sub

Необходимые условия: Рабочая книга должна быть сохранена (обращение идёт именно к файлу Рабочей книги, а не к открытой в Excel Рабочей книге, не к текущим и не сохранённым изменениям); столбец «Ячейки» должен быть заполнен значениями (т.е., не как в первом выложенном Вами варианте).

В коде присутствует жёсткая привязка к адресу — «B2», откуда берётся текущий диапазон для извлечения. Первый запрос («objRecordSet1») извлекает все уникальные Наименования, второй («objRecordSet2») — весь диапазон целиком. Затем происходит вывод второго запроса с группировкой строк по строкам первого запроса. Для упрощения понимания вывод делается в окно отладки («Ctrl-G»), без формирования вывода в ячейки.