VBA遍历文件夹从某个工作表中的多个工作簿中获取数据，但是工作表名称在不同的工作簿中有所不同

Question

我遍历文件夹中的所有excel文件，以从每个工作簿中的特定工作表中获取数据，并将数据合并到主工作簿中。

问题在于工作表名称在14个工作簿中的9个中为“ Mthly KPI usd”，而其余的则不同，因此我不能更改工作表的名称。

我该如何解决这个问题？ 谢谢。

这是我的代码：

Sub LoopThroughFolder()

    Dim myCol As Long
    Dim my_FileName As Variant
    Dim i As Long
    Dim lnRow As Long, lnCol As Long

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    'change the address to suite
    MyDir = "E:\John\2017\"
    MyFile = Dir(MyDir & "*.xl*")    'change file extension
    ChDir MyDir
    Dim current As String
    current = CurDir

    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        If MyFile = "Master.xlsm" Then
        Exit Sub
        End If
        Workbooks.Open (MyDir + MyFile)
        With Worksheets("Mthly KPI usd")
            Rws = Cells(Rows.Count, "P").End(xlUp).Row
            lnRow = 2
            lnCol = ActiveSheet.Cells(lnRow, 1).EntireRow.Find(What:="Oct", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
            MsgBox lnCol
            Set Rng = Range(.Cells(4, lnCol), .Cells(Rws, lnCol))
            Rng.Copy Wb.Sheets("Test").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close True
        End With
        MyFile = Dir()
    Loop

End Sub

Answer 1

替换来自

Workbooks.Open (MyDir + MyFile)

至

End With

与以下

Dim wb as Workbook
Dim ws as Worksheet
Set wb = Workbooks.Open (MyDir + MyFile)
For Each ws in wb.Worksheets
    if InStr(1, ws.Name, "Mthly KPI") > 0 then
        With ws
        ' Add your code which copies data from the source worksheet to the master worksheet
        Rws = Cells(Rows.Count, "P").End(xlUp).Row
        End ws
    End If
Next ws