Excel 我们不需要外部链接，而是需要使用VBA与合并工作簿建立内部链接_Excel_Vba

Excel 我们不需要外部链接，而是需要使用VBA与合并工作簿建立内部链接

excel vba

Excel 我们不需要外部链接，而是需要使用VBA与合并工作簿建立内部链接,excel,vba,Excel,Vba,我的目标是将任何指定文件夹中包含多张工作表的所有工作簿合并到一个包含多张工作表的工作簿中。（我在下面附上了代码）问题是我不想维护外部链接，我尝试使用宏来断开这些链接，它也在工作。（仅使用断开链接命令，附在下面）但我真正想要的是，在将所有工作簿合并到一个工作簿中之后，我需要的不是外部链接而是与这些合并的工作表之间的链接，那么有什么策略可以使用吗将所有工作簿合并到一个工作簿的代码要正确移动所有公式引用，请执行以下操作：开始移动之前，打开所有涉及的文件移动您的工作表（不要复制它们）所有移

我的目标是将任何指定文件夹中包含多张工作表的所有工作簿合并到一个包含多张工作表的工作簿中。（我在下面附上了代码）问题是我不想维护外部链接，我尝试使用宏来断开这些链接，它也在工作。（仅使用断开链接命令，附在下面）

但我真正想要的是，在将所有工作簿合并到一个工作簿中之后，我需要的不是外部链接而是与这些合并的工作表之间的链接，那么有什么策略可以使用吗

将所有工作簿合并到一个工作簿的代码

要正确移动所有公式引用，请执行以下操作：

开始移动之前，打开所有涉及的文件

移动您的工作表（不要复制它们）

所有移动完成后：关闭不再需要的文件（如果希望保持原始文件与移动图纸之前相同，请不要保存更改）

保存合并的工作簿

以下是概念证明：

首先，我们创建3个文件，每个文件有2个工作簿

Public Sub CreateTestWorkbooks()
    Const Path As String = "C:\Temp\MoveTest\"
    Const nWb As Long = 3 'amount of workbooks to create
    Const nWs As Long = 2 'amount of worksheets in each workbook
    
    Dim NewWb() As Workbook
    ReDim NewWb(1 To nWb) As Workbook
    
    Dim iWs As Long
    
    Application.ScreenUpdating = False
    
    'create workbooks
    Dim iWb As Long
    For iWb = 1 To nWb
        Set NewWb(iWb) = Application.Workbooks.Add
        For iWs = 1 To nWs - 1
            NewWb(iWb).Worksheets.Add After:=NewWb(iWb).Sheets(NewWb(iWb).Sheets.Count)
        Next iWs
        NewWb(iWb).SaveAs Filename:=Path & "File" & iWb & ".xlsx"
    Next iWb
    
    'write formulas
    Dim iFormula As Long
    For iWb = 1 To nWb
        For iWs = 1 To nWs
            NewWb(iWb).Worksheets(iWs).Range("A1").Value = "File" & iWb & ".xlsx " & "Sheet" & iWs
            For iFormula = 1 To nWb
                NewWb(iWb).Worksheets(iWs).Cells(iFormula, "B").Formula = "=[File" & iFormula & ".xlsx]Sheet" & iWs & "!$A$1"
            Next iFormula
        Next iWs
    Next iWb
    
    'save and close workbooks
    For iWb = 1 To nWb
        NewWb(iWb).Close SaveChanges:=True
    Next iWb
    
    Application.ScreenUpdating = True
    MsgBox "All " & nWb & " files were created.", vbInformation
End Sub

然后我们把它们合并起来

Public Sub ConsolidateWorkbooks()
    Const Path As String = "C:\Temp\MoveTest\"
    
    Dim OpenedWorkbooks As Collection
    Set OpenedWorkbooks = New Collection
    
    Application.ScreenUpdating = False
    
    'loop through files and open them all
    Dim File As String
    File = Dir(Path & "*.xlsx")
    Do While File <> vbNullString
        OpenedWorkbooks.Add Application.Workbooks.Open(Filename:=Path & File, UpdateLinks:=True)
        File = Dir()
    Loop
    
    'create a new workbook to consolidate all worksheets
    Dim ConsolidateWb As Workbook
    Set ConsolidateWb = Application.Workbooks.Add
    
    'consolidate
    Dim wb As Workbook
    For Each wb In OpenedWorkbooks
        Dim sh As Variant
        For Each sh In wb.Sheets
            sh.Move After:=ConsolidateWb.Sheets(ConsolidateWb.Sheets.Count)
            
            'this changes the constant in A1 of each sheet to make it
            'visible that formulas are now pointing to the new file (no formula changes are made here)
            With ConsolidateWb.Sheets(ConsolidateWb.Sheets.Count)
                .Range("A1").Value = "Consolidated.xlsx " & .Name
            End With
        Next sh
    Next wb
    
    Application.ScreenUpdating = True
    
    ConsolidateWb.SaveAs Filename:=Path & "Consolidated.xlsx"
End Sub

公共子合并工作簿（）
常量路径为String=“C:\Temp\MoveTest”
将打开的工作簿作为收藏
设置打开的工作簿=新集合
Application.ScreenUpdating=False
'循环浏览文件并将其全部打开
将文件设置为字符串
File=Dir（路径&“*.xlsx”）
当文件为vbNullString时执行
OpenedWorkbooks.Add Application.Workbooks.Open（文件名：=路径和文件，UpdateLinks:=真）
File=Dir（）
环
'创建新工作簿以合并所有工作表
Dim ConsolidateWb作为工作簿
设置ConsolidateWb=Application.Workbooks.Add
"巩固",
将wb设置为工作簿
对于打开的工作簿中的每个wb
Dim-sh作为变体
对于wb.表中的每个sh
sh.移动后：=合并WB.Sheets（合并WB.Sheets.Count）
'这会更改每张图纸A1中的常数，使其
'可见公式现在指向新文件（此处不进行公式更改）
使用ConsolidateWb.Sheets（ConsolidateWb.Sheets.Count）
.Range（“A1”）.Value=“Consolidated.xlsx”和.Name
以
下一个sh
下一个wb
Application.ScreenUpdating=True
ConsolidateWb.SaveAs文件名：=路径和“Consolidated.xlsx”
端接头

我不明白你到底想做什么。如果需要图纸之间的链接，则需要从头开始创建它们。如果希望工作簿之间的旧链接保留在新工作表中，请不要打断它们并尝试

。移动工作表而不是复制它们，这实际上也应该将链接移动到正确的工作表中（如果Microsoft没有将其弄乱的话）。至少试一下。谢谢，@Pᴇʜ感谢您的回复。我试过了，走。尽管如此，我还是得到了同样的结果。让我再解释一下。例如，我有两个工作簿，每个工作簿包含两个工作表（对于工作簿1，工作表a，工作表b，对于工作簿2，工作表x和工作表y）。（活页a）连接到（活页x）和（活页b）连接到（活页y）。我使用上述代码合并了这两本工作簿。现在，如果我更改“原始文件夹”的（表a）中的数据，它也会更改“合并工作簿”的（表x）中的数据。但是，如果我尝试更改“合并工作簿”的（表a）中的数据，我不会更改“合并工作簿”的（表x）中的数据。我想断开合并工作簿与“原始文件夹”工作簿的所有连接，这样，如果我更改“原始文件夹”工作簿中的某些内容，它不会影响“合并工作簿”的数据，但我需要的是，如果我更改合并工作簿中（工作表a）的数据，则（工作表x）的数据应该更改。@Pᴇʜ：我不认为它在所有情况下都有效。。。例如，如果一个链接地址涉及一个工作簿，而该工作簿的每个工作表都没有移动，则引用将不存在。@FaneDuru我实际上打算在最后关闭它们。也许还不清楚，我的坏，将编辑它。我尝试了这个场景，它并不复杂，以适应现有的代码，但它不会改变移动后的初始参考。我在测试文件表名中有一些“Sheet1、Sheet2等”，它们变成了“Sheet1（2）、Sheet2（2）”，但我不认为这是一个原因。可能是吗？你测试过吗？@SamiaJabbar它也可以与自动打开的工作簿一起工作，如我的子合并工作簿中所示。当然，它可以工作！在测试了您的解决方案之后，我想回到我的试验中，为了使用这个新路径（路径可能有一些异常…），我可以看到我使用Copy
而不是Move
构建了我的（简单的）测试子。我发誓我用了Move。。。投票结果。@FaneDuru啊，我们有解释了^^没有解释我就睡不着…：）
Public Sub CreateTestWorkbooks()
    Const Path As String = "C:\Temp\MoveTest\"
    Const nWb As Long = 3 'amount of workbooks to create
    Const nWs As Long = 2 'amount of worksheets in each workbook
    
    Dim NewWb() As Workbook
    ReDim NewWb(1 To nWb) As Workbook
    
    Dim iWs As Long
    
    Application.ScreenUpdating = False
    
    'create workbooks
    Dim iWb As Long
    For iWb = 1 To nWb
        Set NewWb(iWb) = Application.Workbooks.Add
        For iWs = 1 To nWs - 1
            NewWb(iWb).Worksheets.Add After:=NewWb(iWb).Sheets(NewWb(iWb).Sheets.Count)
        Next iWs
        NewWb(iWb).SaveAs Filename:=Path & "File" & iWb & ".xlsx"
    Next iWb
    
    'write formulas
    Dim iFormula As Long
    For iWb = 1 To nWb
        For iWs = 1 To nWs
            NewWb(iWb).Worksheets(iWs).Range("A1").Value = "File" & iWb & ".xlsx " & "Sheet" & iWs
            For iFormula = 1 To nWb
                NewWb(iWb).Worksheets(iWs).Cells(iFormula, "B").Formula = "=[File" & iFormula & ".xlsx]Sheet" & iWs & "!$A$1"
            Next iFormula
        Next iWs
    Next iWb
    
    'save and close workbooks
    For iWb = 1 To nWb
        NewWb(iWb).Close SaveChanges:=True
    Next iWb
    
    Application.ScreenUpdating = True
    MsgBox "All " & nWb & " files were created.", vbInformation
End Sub

Public Sub ConsolidateWorkbooks()
    Const Path As String = "C:\Temp\MoveTest\"
    
    Dim OpenedWorkbooks As Collection
    Set OpenedWorkbooks = New Collection
    
    Application.ScreenUpdating = False
    
    'loop through files and open them all
    Dim File As String
    File = Dir(Path & "*.xlsx")
    Do While File <> vbNullString
        OpenedWorkbooks.Add Application.Workbooks.Open(Filename:=Path & File, UpdateLinks:=True)
        File = Dir()
    Loop
    
    'create a new workbook to consolidate all worksheets
    Dim ConsolidateWb As Workbook
    Set ConsolidateWb = Application.Workbooks.Add
    
    'consolidate
    Dim wb As Workbook
    For Each wb In OpenedWorkbooks
        Dim sh As Variant
        For Each sh In wb.Sheets
            sh.Move After:=ConsolidateWb.Sheets(ConsolidateWb.Sheets.Count)
            
            'this changes the constant in A1 of each sheet to make it
            'visible that formulas are now pointing to the new file (no formula changes are made here)
            With ConsolidateWb.Sheets(ConsolidateWb.Sheets.Count)
                .Range("A1").Value = "Consolidated.xlsx " & .Name
            End With
        Next sh
    Next wb
    
    Application.ScreenUpdating = True
    
    ConsolidateWb.SaveAs Filename:=Path & "Consolidated.xlsx"
End Sub