將多個文件的可見工作表列入主文件

Question

我是VBA中的新成員，我想這很簡單，但我解決不了。

我有一個Masterfile.xlsm其中有幾個.xlsb文件及其各自的文件夾路徑的列表。它所要做的就是轉到每個文件，看看它的全部可見表格，然後在Masterfile.xlsm中列出。

這是迄今爲止我所有的，但它不能正常工作。

Sub sheets_count() 

Dim i As Long, n As Long 
Dim FilePath As String 
Dim iCell As String 

Application.EnableCancelKey = xlDisabled 

ActiveWorkbook.Sheets("Control").Activate 
LastRow = Range("D2").End(xlDown).Row 
intRowCount = LastRow 
FilePath = ActiveSheet.Range("A2").Value 

For i = 1 To Worksheets.Count 
Workbooks("Masterfile.xlsm").Activate 
Sheets("Control").Select 
iCell = Cells(i, 4).Value 
Workbooks.Open FileName:=FilePath & iCell 
If Worksheets(i).Visible = xlSheetVisible Then 
    i = i + 1 
    Workbooks("Masterfile.xlsm").Activate 
    Worksheets("shts_list").Cells(i, i) = iCell 
    Worksheets("shts_list").Cells(i + 1, i) = Sheets(i).Name 
End If 
Next i 
End Sub 

任何想法？

Answer 1

這應該讓你有 - 你可能要調整輸出佈局：

Sub sheets_count() 

    Dim i      As Long 
    Dim LastRow    As Long 
    Dim FilePath    As String 
    Dim sCell     As String 
    Dim rgOut     As Excel.Range 
    Dim wb     As Excel.Workbook 
    Dim wsControl    As Excel.Worksheet 
    Dim wsVis     As Excel.Worksheet 

    With Application 
     .EnableCancelKey = xlDisabled 
     .ScreenUpdating = False 
    End With 

    ' start output in A2 
    Set rgOut = Worksheets("shts_list").Range("A2") 

    Set wsControl = Workbooks("Masterfile.xlsm").Sheets("Control") 

    With wsControl 

     LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 

     FilePath = .Range("A2").Value 
     If Right$(FilePath, 1) <> "\" Then FilePath = FilePath & "\" 

     For i = 1 To LastRow 

      sCell = .Cells(i, 4).Value 

      With Workbooks.Open(Filename:=FilePath & sCell) 
       rgOut.Value = sCell 
       Set rgOut = rgOut.Offset(1) 
       For Each wsVis In .Worksheets 

        If wsVis.Visible = xlSheetVisible Then 
         rgOut.Value2 = wsVis.Name 
         Set rgOut = rgOut.Offset(1) 
        End If 

       Next wsVis 

       .Close False 

      End With 

     Next i 

    End With 

    With Application 
     .ScreenUpdating = True 
     .EnableCancelKey = xlInterrupt 
    End With 
End Sub