当一些工作簿只有一张，一些有很多，一些有隐藏的工作表时，将多个工作簿中的工作表复制到当前工作簿中答案

【问题标题】：Copying worksheets from multiple workbooks into current workbook when some workbooks have one sheet, some have many, some have hidden worksheets当一些工作簿只有一张，一些有很多，一些有隐藏的工作表时，将多个工作簿中的工作表复制到当前工作簿中
【发布时间】：2017-07-14 19:46:57
【问题描述】：

正如标题所说，我正在尝试将一组工作簿中的所有可见工作表复制到一个工作簿中。

所有工作簿始终位于同一目录中，但文件名会有所不同。我最初尝试使用下面的代码，但我遇到了“下一张表”行尝试转到工作簿中的下一张表的问题，即使没有更多的工作表也是如此。

更具体地说，我尝试合并的基础工作簿具有不同数量的工作表；有些人有一个，有些人有很多，有些人也有很多隐藏的工作表。我只是想复制可见的工作表，并且需要能够处理工作簿可能有一张或多张工作表的情况。

我尝试了下面代码的变体，在其中我会计算工作表并在有一张或多张工作表时转到单独的代码，但这也不起作用。非常感谢任何帮助，感谢大家的宝贵时间。

Sub ConslidateWorkbooks()

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "MyPath"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename
 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

【问题讨论】：

您是否只是在单步执行代码并检查副本是否有效时遇到问题？ ActiveWorkbook 应该是由 Workbooks.Open 语句打开的工作簿，但如果您在代码运行时与工作簿交互，ActiveWorkbook 将是您正在查看的任何工作簿当它到达那条线时。（这就是不鼓励使用ActiveWorkbook、ActiveSheet、Selection 等的原因。）

标签： vba excel

【解决方案1】：

您应该为您打开的工作簿分配一个对象引用，而不是依赖ActiveWorkbook：

Dim wb As Workbook
Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=FolderPath & Filename)
    For Each Sheet In wb.Sheets
        If Sheet.Visible = xlSheetVisible Then 'only copy visible sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        End If
    Next Sheet
    wb.Close
    Filename = Dir()
Loop

通过避免使用ActiveWorkbook，您将解决用户提出的问题，这些问题是您的代码没有预料到的。

【讨论】：

【解决方案2】：

尝试以下方法：

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

With ActiveSheet
    Range("A1").Activate
End With

Application.ScreenUpdating = False
FolderPath = ActiveWorkbook.Path & "\"
Filename = Dir(FolderPath & "*.xls*")

Do While Filename <> ""
   Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
   For Each Sheet In ActiveWorkbook.Sheets
   If Sheet.Visible = TRUE Then
       copyOrRefreshSheet ThisWorkbook, Sheet
   End If
   Next Sheet
   Workbooks(Filename).Close
   Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub



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

【讨论】：