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

Question

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

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

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

Sub merge()
Dim FolderPath As String    
Dim Filename As String    
Dim Sheet As Worksheet    

Application.ScreenUpdating = False 

FolderPath = "C:UsersSamiya jabbarDesktoptest"    
Filename = Dir(FolderPath)    

Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets    
Sheet.Copy After:=ThisWorkbook.Sheets(1)    
Next Sheet  

Workbooks(Filename).Close
Filename = Dir()
Loop

Application.ScreenUpdating = True
End Sub

断开链接

Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link

Answer 1

为了正确移动所有公式引用：

1. 在开始移动之前打开所有涉及的文件
2. 移动你的床单(不要复印(
3. 在完成所有移动后：关闭不再需要的文件(如果要保持原始文件与移动图纸前一样，则不要保存更改(
4. 保存合并后的工作簿

---

这里有一个概念证明：

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

Public Sub CreateTestWorkbooks()
Const Path As String = "C:TempMoveTest"
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:TempMoveTest"

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