Código VBA para copiar hojas de trabajo que contienen rangos con nombre desde el libro de trabajo de origen hasta el de destino

Question

Tengo 2 libros de trabajo. Un libro de trabajo de origen y un libro de trabajo de destino. Son completamente iguales excepto por 1 hoja de trabajo que tiene el mismo nombre en ambos pero datos diferentes (ambos contienen alrededor de 30 hojas). Lo que quería era copiar el resto de las hojas de trabajo idénticas del libro de trabajo de origen al libro de trabajo de destino, dejando esa hoja de trabajo 1 que difiere en los datos.

Básicamente, las hojas de trabajo idénticas presentes en el libro de trabajo de destino deben reemplazarse con las del libro de trabajo de origen. Las hojas de trabajo contienen fórmulas y rangos con nombre. Pude escribir con éxito el código VBA para copiar las hojas de trabajo. Pero dado que los rangos nombrados tienen un alcance de libro de trabajo. Los rangos con nombre aún se refieren a ubicaciones en los libros de trabajo de origen. Entonces obtengo 2 rangos con nombre con el mismo nombre. Algo como:

'The one already present in the destination workbook (from the worksheet which was replaced)
Name=VaccStart , Refers To =Sheet2!$A$2 
'The one due to the copied worksheet.
Name=VaccStart , Refers To =[C:\Users\.....\Source.xls]Sheet2!$A$2 

Quiero que los rangos con nombre se refieran al libro de trabajo de destino y no al libro de trabajo de origen cuando los copie. Dado que todas las hojas en ambos libros de trabajo son iguales y solo las estoy reemplazando.

Answer 1

Una forma fácil de evitar la creación de enlaces inadvertidos al pasar de un libro de trabajo de origen a destino es volver a vincular el libro de trabajo de destino desde el origen a sí mismo

Captura de pantalla de xl2010

• Editar .... Enlaces
• "Cambiar fuente" y elegir el archivo actual como la nueva fuente

Answer 2

Esto modificará los rangos con nombre para eliminar la referencia del archivo externo:

Sub ResetNamedRanges()
    Dim nm As Name
    Dim sRefersTo As String
    Dim iLeft As Integer
    Dim iRight As Integer

    For Each nm In ActiveWorkbook.Names
        sRefersTo = nm.RefersTo
        iLeft = InStr(sRefersTo, "[")
        iRight = InStr(sRefersTo, "]")
        If iLeft > 1 And iRight > 0 Then
            sRefersTo = Left$(sRefersTo, iLeft - 1) & Mid$(sRefersTo, iRight + 1)
            nm.RefersTo = sRefersTo
        End If
    Next nm
End Sub