简体   繁体   中英

VBA looping through a folder to get data from multiple workbooks from a certain sheet, but the sheet name varies in different workbooks

I am looping through all the excel files in a folder to get data from a particular sheet in each workbook and consolidating the data into a master workbook.

The problem is that the sheet name is 'Mthly KPI usd' in 9 of the 14 workbooks while the rest are different and I am not allowed to change the name of the worksheet.

How can I resolve this issue? Thank you.

This is my code :

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

Replace the lines from

Workbooks.Open (MyDir + MyFile)

to

End With

with the following

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM