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

【问题标题】：VBA looping through a folder to get data from multiple workbooks from a certain sheet, but the sheet name varies in different workbooksVBA遍历文件夹以从某个工作表的多个工作簿中获取数据，但工作表名称在不同工作簿中有所不同
【发布时间】：2017-12-20 06:43:37
【问题描述】：

我正在遍历文件夹中的所有 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

【问题讨论】：

只使用表号而不是名称？
你知道其他5个文件中的工作表名称吗？这些文件中的名称是否相同？
嗨@crimson589，工作表编号也不同，Tim Williams 的名称在其他 5 个文件中也不同。
你好@cbasah 谢谢你的解决方案。我通过将所有必填字段存储在一个表中来使用映射到各种文件和工作表，并使用函数从该表中获取工作表名称和其他必填字段。

标签： vba excel

【解决方案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

【讨论】：