Przysiadłem i napisałem tą funkcję, o której mówiłem (a w zasadzie zestaw funkcji). Tak to wygląda w kodzie:
Public Function SortShopProducts(ParamArray params() As Variant) As Variant
Dim result() As Variant
Dim i, j, k, maxRows, maxColumns As Integer
Dim shops() As Range
Dim productNames() As String
Dim add As Boolean
ReDim shops(LBound(params) To UBound(params)) As Range
For i = LBound(params) To UBound(params)
Set shops(i) = params(i)
Next i
Call BubbleSortRangeArray(shops)
ReDim productNames(0 To 0)
add = False
For i = LBound(shops) To UBound(shops)
For j = 2 To shops(i).Rows.Count
If Not StringExists(shops(i).Item(j, 1), productNames) Then
If Not add Then
add = True
Else
ReDim Preserve productNames(0 To UBound(productNames) + 1) As String
End If
productNames(UBound(productNames)) = shops(i).Item(j, 1)
End If
Next j
Next i
Call BubbleSortStringArray(productNames)
maxRows = UBound(productNames) + 2
maxColumns = UBound(shops) + 2
ReDim result(1 To maxRows, 1 To maxColumns)
result(1, 1) = shops(0).Item(1, 1)
For i = LBound(productNames) To UBound(productNames)
result(i + 2, 1) = productNames(i)
Next i
For i = LBound(shops) To UBound(shops)
result(1, i + 2) = shops(i).Item(1, 2)
For j = LBound(productNames) To UBound(productNames)
For k = 2 To shops(i).Rows.Count
If StrComp(shops(i).Item(k, 1), productNames(j), vbTextCompare) = 0 Then
result(j + 2, i + 2) = shops(i).Item(k, 2)
End If
Next k
Next j
Next i
SortShopProducts = result
End Function
Public Function StringExists(s As String, sArr() As String) As Boolean
Dim i As Integer
Dim result As Boolean
result = False
For i = LBound(sArr) To UBound(sArr)
If StrComp(sArr(i), s, vbTextCompare) = 0 Then result = True
Next i
StringExists = result
End Function
Public Sub BubbleSortStringArray(ByRef sArr() As String)
Dim i As Long, j As Long
Dim sTemp As String
For i = LBound(sArr) To UBound(sArr) - 1
For j = i To UBound(sArr)
If StrComp(sArr(i), sArr(j), vbTextCompare) = 1 Then
sTemp = sArr(i)
sArr(i) = sArr(j)
sArr(j) = sTemp
End If
Next j
Next i
End Sub
Public Sub BubbleSortRangeArray(ByRef rArr() As Range)
Dim i As Long, j As Long
Dim rTemp As Range
For i = LBound(rArr) To UBound(rArr) - 1
For j = i To UBound(rArr)
If StrComp(rArr(i).Item(1, 2), rArr(j).Item(1, 2), vbTextCompare) = 1 Then
Set rTemp = rArr(i)
Set rArr(i) = rArr(j)
Set rArr(j) = rTemp
End If
Next j
Next i
End Sub
Jak tego używać? W tym Twoim przykładowym skoroszycie robisz sobie np. nowy arkusz. W komórce A1 wstawiasz takie coś:
=SortShopProducts(Arkusz1!A1:B11;Arkusz2!A1:B12)
Potem zaznaczasz obszar 15x3 (na niebiesko) i wciskasz kombinację klawiszy Ctrl + Shift + Enter i gotowe. Wiersze z nazwami produktów oraz kolumny z nazwami sklepów są od razu posortowane alfabetycznie.
Dlaczego 15x3?
15 wierszy, bo jest 14 różnych produktów + wiersz z nagłówkiem
3 kolumny, bo są 2 sklepy + kolumna z nagłówkiem
Jeśli będzie więcej sklepów to po prostu po średnikach podajesz tabele z danymi dla tych sklepów. Oczywiście przy innej ilości sklepów i innej ilości produktów będziesz musiał zaznaczyć inny obszar. Generalnie lepiej zaznaczyć większy obszar niż się powinno aniżeli mniejszy 
Jak zaznaczysz większy to po prostu w niektórych komórkach będziesz miał informację o błędzie, ale w pozostałych będą poprawne wartości.
Zaraz wrzucę przykładowy formularz.
Link: http://rapidshare.com/files/428742988/Przyk__ad1.xlsm
PS Konstruktywna krytyka mile widziana
Pozdrawiam,
– Dodane 04.11.2010 (Cz) 12:33 –
Hm, niedokładnie opisałem jak to trzeba uruchomić … Jeszcze raz 
Wstawiamy odpowiednią formułę do dowolnej komórki w dowolnym arkuszu (np. komórki A1 w arkuszu 4 jak wspomniałem wyżej).
Następnie zaznaczamy odpowiedni obszar (dla powyższego przykładu będzie to obszar 15x3).
Następnie klikamy myszką w miejscu, gdzie wstawiliśmy tą formułę i dopiero wtedy należy nacisnąć Ctrl + Shift + Enter.
Dołączam krótki filmik (nazwijmy to) instruktażowy http://rapidshare.com/files/428853972/przyklad.avi (plik ma niecały 1 MB)
