Macro que combine celdas mientras crea libros Excel.

Para Dante:

Dante estoy trabajando en un reporte de piking automático para almacén, hace un tiempo me ayudaste en una macro que te vaya creando libros de acuerdo a una platilla.

El tema de generar libros por clientes si me funciona, pero se me ocurre, no se si es factible que a medida que genere libros también pueda ir combinando celdas, en una pregunta anterior me resolviste ese tema pero todo se ejecuta en el mismo libro, quisiera saber si se puede añadir un código que vaya combinado a medida que va creando libros por cliente.

Las plantillas que me generan son así:

Quisiera saber si con un codigo puede crear libros pero combinando las celdas Entrega y Tiendas, teniendo en cuenta como la vez anterior que una entrega puede tener varias tiendas.

Tendría que quedar como en la foto:

Este es tu macro que estoy adaptando para que me genere libros por cliente, donde anteriormente.

Sub Por_OD()
'Aporte  Ronald C
'Como el usuario dinamico este codigo ayuda a capturar al cualquiera que se loggea
Dim struser As String
struser = CreateObject("WScript.Network").UserName
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set h2 = l1.Sheets("Por OD")
    '
    If h1.FilterMode Then h1.ShowAllData
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range("H:H").Copy h1.Range("AF1")
    h1.[h1].Copy h1.[AG1]
    h1.Range("AF1:AF" & u).RemoveDuplicates Columns:=1, Header:=xlYes
    '
    For i = 2 To h1.Range("AF" & Rows.Count).End(xlUp).Row
        h1.[AG2] = h1.Cells(i, "AF")
        h1.Range("D1:H" & u).AdvancedFilter Action:=xlFilterInPlace, _
            CriteriaRange:=h1.Range("AG1:AG2"), Unique:=False
        u2 = h1.Range("A" & Rows.Count).End(xlUp).Row
        h2.Copy
        Set l2 = ActiveWorkbook
        Set h3 = l2.ActiveSheet
        h1.Range("C2:F" & u2).Copy h3.Range("A9")
        h1.Range("N2:N" & u2).Copy h3.Range("E9")
        h1.Range("M2:M" & u2).Copy h3.Range("F9")
        'Actualizado Por. Dante Amor
        l2.SaveAs Filename:="C:\Users\" & struser & "\Desktop\SEPARAR PICKING\" & h1.Cells(i, "AF") & ".xls", _
        FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        l2.Close
    Next
    If h1.FilterMode Then h1.ShowAllData
    h1.Range("AF:AG").ClearContents
    Application.ScreenUpdating = True
Range("A11:K10000"). EntireColumn. AutoFit
Range("A11:K10000"). EntireRow. AutoFit
    MsgBox "Terminado"

Si deseas que te envíe mi archivo a tu correo me confirmas.