Arbeitsblätter mit VBA-Code zum Kopieren, die benannte Bereiche von der Quell- bis zur Zielarbeitsmappe enthalten

Question

Ich habe 2 Arbeitsmappen. Eine Quellarbeitsmappe und eine Zielarbeitsmappe. Sie sind bis auf 1 Arbeitsblatt, das in beiden den gleichen Namen hat, aber unterschiedliche Daten enthält (beide enthalten ungefähr 30 Blätter), völlig gleich. Was ich wollte, war, den Rest der identischen Arbeitsblätter von der Quellarbeitsmappe in die Zielarbeitsmappe zu kopieren und dabei das 1 Arbeitsblatt zu belassen, das die Daten verzögert.

Grundsätzlich sollten die identischen Arbeitsblätter in der Zielarbeitsmappe durch die aus der Quellarbeitsmappe ersetzt werden. Die Arbeitsblätter enthalten Formeln und benannte Bereiche. Ich konnte erfolgreich den VBA-Code schreiben, um die Arbeitsblätter zu kopieren. Da aber die genannten Bereiche einen Arbeitsmappenbereich haben. Die genannten Bereiche beziehen sich weiterhin auf Speicherorte in den Quellarbeitsmappen. Also bekomme ich 2 benannte Bereiche mit dem gleichen Namen. So etwas wie:

'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 

Ich möchte, dass sich die benannten Bereiche auf die Zielarbeitsmappe und nicht auf die Quellarbeitsmappe beziehen, wenn ich sie kopiere. Da alle Blätter in beiden Arbeitsmappen gleich sind und ich sie nur ersetze.

Answer 1

Eine einfache Möglichkeit, die unbeabsichtigte Erstellung von Links beim Wechsel von einer Quell- zur Zielarbeitsmappe zu umgehen, besteht darin, die Zielarbeitsmappe erneut von der Quelle zu sich selbst zu verknüpfen.

Screenshot für xl2010

• Bearbeiten .... Links
• 'Quelle ändern "und wählen Sie die aktuelle Datei als neue Quelle

  

Answer 2

Dadurch werden die benannten Bereiche geändert, um die externe Dateireferenz zu entfernen:

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