try running this which acts on the active sheet: 
Sub blah()
Set mydict = CreateObject("Scripting.Dictionary")
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cll In Range("B12:B" & lr).Cells
  If Not mydict.exists(cll.MergeArea.Address) Then mydict.Add cll.MergeArea.Address, cll.MergeArea
Next cll
For Each itm In mydict.items
  itm.EntireRow.Columns("G:AH").Sort key1:=Range("Q1"), order1:=1
Next itm
End Sub