Combinación de correspondencia varios registros de un mismo socio por carta

Antes de ejecutar la macro, revisa lo siguiente:

1. Tener 4 hojas en tu archivo:

Hoja1 - hoja con la base de datos

Frm - hoja con el formato de la tabla

Tabla - hoja vacía

Temp - hoja vacía

2. En las referencias de VBA tener marcadas las siguientes:

3. El documento de word debe tener los nombres de los encabezados de excel entre corchetes y debes guardar el archivo como plantilla de word.

Te anexo la macro.:

Sub Llenar_Modelo()
'
'   Por Dante Amor
'       Fecha: 14dic2047
'
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("frm")
    Set h3 = Sheets("tabla")
    Set h4 = Sheets("temp")
    h4.Cells.Clear
    '
    '
    'Valores únicos
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    h1.Cells.Copy h4.Range("A1")
    u4 = h4.Range("C" & Rows.Count).End(xlUp).Row
    h4.Range("A1:J" & u4).RemoveDuplicates Columns:=3, Header:=xlYes
    u4 = h4.Range("A" & Rows.Count).End(xlUp).Row
    '
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u4
        Application.StatusBar = "Procesando archivo : " & i & " de : " & u4
        'copia formato1
        h3.Cells.Clear
        h2.Range("A1:F1").Copy h3.Range("A1")
        '
        'filtra un nombre
        nombre = h4.Cells(i, "C")
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
        h1.Range("A1:J" & u1).AutoFilter Field:=3, Criteria1:=nombre
        u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
        h1.Range("G2:J" & u1).Copy h3.Range("C2")
        'copia formato2
        u3 = h3.Range("C" & Rows.Count).End(xlUp).Row
        h2.Range("A2:B2").Copy h3.Range("A2:A" & u3)
        h3.Range("A1:F" & u3).Borders.LineStyle = xlContinuous
        h3.Columns("A:F").WrapText = False
        h3.Columns("A:F").EntireColumn.AutoFit
        '
        'Llena plantilla de word
        ruta = ThisWorkbook.Path & "\"
        patharch = ruta & "plantilla1.dot"
        '
        Set objWord = CreateObject("Word.Application")
        objWord.Visible = True
        objWord.Documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
        '
        For j = 1 To Columns("F").Column
            textobuscar = "[" & h4.Cells(1, j) & "]"
            objWord.Selection.Move 6, -1
            objWord.Selection.Find.Execute FindText:=textobuscar
            objWord.Selection.Text = h4.Cells(i, j) 'texto a reemplazar
        Next
        'Copia y Pega la tabla
        h3.Range("A1:F" & u3).Copy
        objWord.Selection.Move 6, -1
        objWord.Selection.Find.Execute FindText:="[TABLA]"
        objWord.Selection.PasteAndFormat 16   'Type:=wdListCombineWithExistingList
        'https://msdn.microsoft.com/en-us/vba/word-vba/articles/wdrecoverytype-enumeration-word
        '
        nombd = ruta & nombre & ".docx"
        'nombp = ruta & nombre & ".pdf"
        objWord.ActiveDocument.SaveAs nombd
        'pdf = objWord.ActiveDocument.ExportAsFixedFormat( _
            nombp, 17, False, 0, 0, , , 0, False, True, 1)
        objWord.Quit (False)
    Next
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "Archivos generados", vbInformation, "PROCESO TERMINADO"
End Sub

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

¡Gracias! Eres un crack me has sido de mucha ayuda. Valoración más de 10 más que excelente

Hola de nuevo Dante, que tal? ahora necesito algo parecido a la anterior vez pero no lo consigo, ahora en lugar de rellenar 1 tabla deseo rellenar dos tablas distintas en un documento word, extrayendo los datos de un excel. Para Dante Amor

Esto fue con lo que me ayudó la anterior vez  y me sirvió de mucho: Combinación de correspondencia varios registros de un mismo socio por carta

Solicito su colaboración para crear una combinación de correspondencia donde varios registros de mi origen de datos, para este caso excel se combinen en una tabla en la plantilla de word; la idea es que tengo en el excel una columna con el nº de socio (se repite cuantas parcelas tenga) y otra columna con el nº de parcela que este socio tiene, quiero que en la tabla de word, me combine una sola hoja por socio con todas sus parcelas. De la manera que lo estoy haciendo me realiza por cada registro una carta, así las cosas un solo cliente puede resultar hasta con 15 cartas. ¨Para Dante Amor¨. Gracias