Abir archivos de Word con Excel

Se trata de abrir varios y copiar su contenido en un solo Word. Por ejemplo mi Excel es:
1              X             Actividades
2              X             Carga
3                             Productos
4              X             Trabajos
donde se pone X es porque se abrirá el archivo de Word correspondiente (1.doc, 2.doc, etc.) para copiar su información (si no se captura X no se abrirá su documento), se pegará en un Word (rc.doc) agregándose (sin borrar lo anterior) cada nuevo texto, así el ejemplo anterior se vaerá como sigue:
Actividades
                Texto de ejemplo.
Carga
                Otro texto de ejemplo
Trabajos
                Tercer y último párrafo que quedará en rc.doc.
--------------
Mi intento:
Sub RC() 
Dim appWd As Object
Dim RC
RC = "c:\rc.doc"
For i = 1 To 4
If Cells(i, 2) = "X" Then
archivo = i & ".doc"
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
appWd.Documents.Open "c:\" & archivo
With CreateObject("Word.Application")
appWd.Documents "c:\" & archivo 
    Selection.WholeStory 
    Selection.Copy
appWd.Documents.Close "c:\" & archivo
End With 
appWd.Documents.Open (RC) 
    Selection.EndKey Unit:=wdStory 
    Selection.TypeParagraph 
    Selection.TypeParagraph 
    Selection.PasteAndFormat (wdPasteDefault) 
    Selection.TypeParagraph 
    Selection.TypeParagraph 
appWd.Documents.Close (RC)
Else
End If
Next i 
End SubPor ejemplo mi Excel es:
1              X             Actividades
2              X             Carga
3                             Productos
4              X             Trabajos
donde se pone X es porque se abrirá el archivo de Word correspondiente (1.doc, 2.doc, etc.) para copiar su información (si no se captura X no se abrirá su documento), se pegará en un Word (rc.doc) agregándose (sin borrar lo anterior) cada nuevo texto, así el ejemplo anterior se vaerá como sigue:
Actividades
                Texto de ejemplo.
Carga
                Otro texto de ejemplo
Trabajos
                Tercer y último párrafo que quedará en rc.doc.
--------------
Mi intento:
Sub RC()   
Dim appWd As Object
Dim RC
RC = "c:\rc.doc"
For i = 1 To 4
If Cells(i, 2) = "X" Then
archivo = i & ".doc"
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
appWd.Documents.Open "c:\" & archivo
With CreateObject("Word.Application")
appWd.Documents "c:\" & archivo   
    Selection.WholeStory   
    Selection.Copy
appWd.Documents.Close "c:\" & archivo
End With   
appWd.Documents.Open (RC)   
    Selection.EndKey Unit:=wdStory   
    Selection.TypeParagraph   
    Selection.TypeParagraph   
    Selection.PasteAndFormat (wdPasteDefault)   
    Selection.TypeParagraph   
    Selection.TypeParagraph   
appWd.Documents.Close (RC)
Else
End If
Next i   
End Sub

Añade tu respuesta

Haz clic para o