makro – vyhledání více stejných hodnot

Dobrý den, píšu svoje první makro na asi ne úplně nejlehčí téma a jsem v koncích. Mám sešit s několika listy, na každém listu je shodná tabulka s různými daty v buňkách I7:i16. Potřebuju makro, které by mi na nový list vytvořilo souhrnnou tabulku, kde budou v A sloupci názvy listů, v B sloupci hodnoty buněk I17 z jednotlivých listů, v C sloupci maximální hodnoty z buněk i7:i16 a ve sloupci D k tomu dopsány názvy položek z buněk B7:B16. S tabulkami na jednotlivých listech nemůžu hýbat (seřazovat číselné hodnoty apod.). Co jsem mohl, to jsem nastudoval, a pokud je v buňkách i7:i16 jen jedna max hodnota, umím to celé zprovoznit (i když možná kostrbatě). Pokud je však hodnot více, jsem v koncích. Optimálně bych potřeboval, aby se v takovém případě za max hodnotu ve sloupci C vypisovaly dotčené názvy položek do dalších slouců (D, E, …). Tedy pokud například budu na Listu2 hledat hodnotu 5, která je tam dvakrát, na nově vytvořeném listě se mi do C2 vypíše číslo 5, do D2 název první položky, ke které je číslo 5 přiřazené a do E2 název druhé položky, ke které je číslo 5 přiřazené.
Vím, že je to na popis dost složité, ale pomůže mi někdo prosím? Zatím to mám takto:
For i = 1 To Sheets.Count – 1
Cells(i + 1, 1) = Sheets(i).Name
Next i

For a = 1 To Sheets.Count – 1
Cells(a + 1, 2) = Worksheets(a).Range(“i17”).Value
Next a

For b = 1 To Sheets.Count – 1
xx = Application.WorksheetFunction.Max(Worksheets(b).Range(“i7:i16”))
Cells(b + 1, 3) = xx
Next b

For d = 1 To Sheets.Count – 2
Worksheets(d).Range(“b7:b16”).Copy
Worksheets(d).Range(“j7”).PasteSpecial xlPasteValues

hodnota = Cells(d + 1, 3).Value
pocet = Application.WorksheetFunction.CountIf(Worksheets(d).Range(“I7:I16”), hodnota)
If pocet = 1 Then
oblast1 = Worksheets(d).Range(“I7:J16”).Value
nalez = Application.WorksheetFunction.VLookup(hodnota, oblast1, 2, False)
Cells(d + 1, 4) = nalez
End If

If pocet > 1 Then
??? tady už nevím…
End If

Worksheets(d).Range(“j7:j16”).ClearContents
Next d
End Sub