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

VBA循环遍历文件夹以从特定工作表中获取多个工作簿中的数据，但工作表名称因工作簿

1 个答案: