Excelmacros：从多个工作簿中复制工作表添加刷新function

我正在寻找合并多个Excel文件中的工作表到具有刷新/更新function的一个主文件。

更具体地说，我在一个文件夹中有25个工作簿，结构相同，实体不同。 每个文件都有一个表单，与文件的名称相同。 每个实体将每周更新他们的具体文件与最新的数字值。 我想创build一个macros，它将：

1. 复制每个文件中的一个工作表并将其粘贴到一个“主”工作簿中。
2. 有添加的function，使我可以“刷新”这些复制/粘贴标签每周。

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

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 

这段代码工作正常，从多个工作簿中的数据拉入主工作簿，但我需要添加一些刷新能力，没有删除和重新复制选项卡（因为我在主表中的其他选项卡中的链接将成为＃ REF如果表被删除并重新复制）。

提前谢谢你的帮助。

Answer 1

基本上你想刷新工作表的数据，如果它已经存在于ThisWorkbook ，否则复制/添加它。 你可以使用这个子程序来完成这个工作：

 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