Excel宏:通过添加刷新功能从多个工作簿复制表

时间:2017-07-05 16:47:16

标签: excel vba excel-vba worksheet consolidation

我希望将多个Excel文件中的工作表合并到一个具有刷新/更新功能的主文件中。

更具体地说,我在一个文件夹中有~25个工作簿,它们的结构相同并且根据实体而有所不同。每个文件都有一个工作表,与文件名相同。每个实体每周都会使用最新的数字值更新其特定文件。我想创建一个宏:

  1. 从每个文件中复制一个工作表并将其粘贴到一个" Master"工作簿。
  2. 具有允许我刷新"的附加功能这些复制/粘贴标签每周一次。
  3. 到目前为止我有这个代码:

    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。

    提前感谢您的帮助。

1 个答案:

答案 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