Sub LoopThroughFolder()

Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Dim Rws As Long, Rng As Range
Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("IT&SYS")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()
 Loop

Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Prof Cons")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop

Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Travel")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop


Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Conference&Entertainment")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop

Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Staff Rel")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop

Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Other")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

 Loop

Set Wb = ThisWorkbook
MyDir = "D:PersonalDataBodaBaliDesktopvba loop"
MyFile = Dir(MyDir & "*.xl??")
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0

Do While MyFile <> ""
    Workbooks.Open (MyFile)
    With Worksheets("Facilities&Real Estate")
        Rws = .Cells(Rows.Count, "A").End(xlUp).Row
        Set Rng = Range(.Cells(1, 35), .Cells(Rws, 2))
        Rng.Copy Wb.Worksheets("Sheet7").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        ActiveWorkbook.Close True
    End With
    MyFile = Dir()

Loop
End Sub