Случайный выбор из таблицы

[dimale]

Добрый день. Вообщем столкнулся с такой задачей. Есть 2 таблицы, довольно громоздкие, одна 2к+ строк, другая 16к+. По одному параметру(значения одного столбика) обе таблицы делятся на большое число групп. Надо случайным образом выбрать из большей таблицы таблицу с таким же количеством строк как у меньшей, и с таким же "распределениям по группам" как у меньшей.
Если малое количество групп, то, в принципе, знаю как делать, рассматриваю каждую группу отдельно. Но вот если групп 30 или даже 300, то вызывает затруднение.
Прикрепил файл с примерной задачей, обе таблицы "поделены" на 15 групп

табл.rar

[IgorGO]

в колонке В местами группы не указаны.
результаты будут в Д:Е. группы тех же размеров что в А:В, фамилии случайны.

Sub NewTable()
  Dim g() As Long, gc As Long, i As Long, n As Long, r As Long, lr As Long
  Randomize
  gc = WorksheetFunction.Max(Columns(9))
  n = WorksheetFunction.Count(Columns(2))
  lr = WorksheetFunction.Count(Columns(9)) - 2
  ReDim g(gc): r = 0
  For i = 1 To gc
    g(i) = WorksheetFunction.CountIf(Columns(2), i)
    r = r + g(i)
  Next
  i = 0:  Cells(1, 7) = 1
  Do
    r = Rnd() * lr + 2
    If Cells(r, 7) = "" Then
      If g(Cells(r, 9)) > 0 Then
        g(Cells(r, 9)) = g(Cells(r, 9)) - 1:  i = i + 1: Cells(r, 7) = 1
        Application.StatusBar = "из " & n & "  готово " & i
      End If
    End If
  Loop Until i >= n
  Application.Intersect(Columns(7).SpecialCells(xlCellTypeConstants).EntireRow, Range("H:I")).Copy Destination:=[d1]
  Columns(7).ClearContents
  Application.StatusBar = False
End Sub

[dimale]

Большое спасибо, буду разбираться