将多个文件的可见表格列入主文件

时间:2015-06-25 13:15:23

标签: excel vba excel-vba

我是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

任何想法?

1 个答案:

答案 0 :(得分:0)

这应该可以帮助您 - 您可能需要调整输出布局:

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