Question

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

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

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

我曾尝试过以下代码的变体，我会计算工作表，如果有一个或多个工作表，则转到单独的代码，但这也不起作用。非常感谢任何帮助，谢谢大家的时间。

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

Answer 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，您将解决用户提出的代码不期望的问题。

Answer 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

当一些工作簿有一个工作表，有些工作簿有很多工作表，有些工作表有隐藏的工作表

2 个答案: