Excel 宏：从多个工作簿复制工作表并添加刷新功能

Question

我希望将多个 Excel 文件中的 sheet 合并到一个具有 refresh/update 功能的主文件中。

更具体地说，我在一个文件夹中有大约 25 个工作簿，它们的结构相同，但因实体而异。每个文件都有一个sheet，与文件名相同。每个实体每周都会用最新的数值更新他们的特定文件。我想创建一个宏：

从每个文件中复制一份工作sheet并将它们粘贴到一个"Master"工作簿中。
增加了功能，让我每周 "refresh" 这些 copy/pasted 标签页。

到目前为止我有这个代码：

Sub ConslidateWorkbooks()
'Code to pull sheets from multiple Excel files in one file directory
'into master "Consolidation" sheet.

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet

Application.ScreenUpdating = False
FolderPath = "....."       'I have this filled in my code
Filename = Dir(FolderPath & "*.xls*")

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

此代码可以很好地将多个工作簿中的数据提取到一个主工作簿中，但我需要添加某种刷新功能而不删除和重新复制选项卡（因为我在主工作簿的其他选项卡中有链接sheet 如果 sheet 被删除并重新复制，它将成为 #REF。

提前感谢您的帮助。

Answer 1

基本上，如果 ThisWorkbook 中已经存在工作表数据，则您需要刷新，否则 copy/add。您可以使用此子例程来完成此操作：

Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet)
  Dim ws As Worksheet
  On Error Resume Next
  Set ws = destWb.Worksheets(sourceWs.Name)
  On Error GoTo 0
  If ws Is Nothing Then
    sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.count)
  Else
    ws.Cells.ClearContents
    ws.Range(sourceWs.UsedRange.Address).value = sourceWs.UsedRange.Value2
  End If
End Sub

现在要使用它，请从您的例程代码中更改这一行：

Sheet.Copy After:=ThisWorkbook.Sheets(1)

进入：

copyOrRefreshSheet ThisWorkbook, sheet

Excel 宏：从多个工作簿复制工作表并添加刷新功能

Excel Macro: Copy Sheets from Multiple Workbooks WITH Added Refresh Capability

excel

vba

worksheet

consolidation