我希望将多个Excel文件中的工作表合并到一个具有刷新/更新功能的主文件中。
更具体地说,我在一个文件夹中有~25个工作簿,它们的结构相同并且根据实体而有所不同。每个文件都有一个工作表,与文件名相同。每个实体每周都会使用最新的数字值更新其特定文件。我想创建一个宏:
到目前为止我有这个代码:
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。
提前感谢您的帮助。
答案 0 :(得分:2)
基本上,如果工作表的数据已存在于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