Search code examples
vbaexcelloopsconsolidation

Vba loop through folders with values

I am a really beginner of vba macro writing and I am facing an issue. I looked up a loop macro which loops the files in one folder and make a consolidated one. The problem is that some of the files have functions so in some columns I am facing reference issue so I would need values instead of the functions. I have been looking for solutions for two days but no progress. I am a trainee at a multinational company and it would make my job easier. Here is my macro:

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:\PersonalData\BodaBali\Desktop\vba 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:\PersonalData\BodaBali\Desktop\vba 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:\PersonalData\BodaBali\Desktop\vba 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:\PersonalData\BodaBali\Desktop\vba 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:\PersonalData\BodaBali\Desktop\vba 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:\PersonalData\BodaBali\Desktop\vba 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:\PersonalData\BodaBali\Desktop\vba 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
Solution

  • You'll need to do your .Copy and .Paste in two lines instead of one:

    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).PasteSpecial xlPasteValues
    ActiveWorkbook.Close True
End With

    Also, agreeing with everyone that one loop would be best here, dealing with each worksheet inside that loop.

    Something like:

    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:\PersonalData\BodaBali\Desktop\vba 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).PasteSpecial xlPasteValues        
    End With
    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).PasteSpecial xlPasteValues       
    End With
    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).PasteSpecial xlPasteValues        
    End With
    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).PasteSpecial xlPasteValues        
    End With
    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).PasteSpecial xlPasteValues        
    End With
    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).PasteSpecial xlPasteValues       
    End With
    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)       
    End With
    ActiveWorkbook.Close True
    MyFile = Dir()
 Loop




End Sub

    This could still be cleaned up since there is a lot of copy/paste code in here, but this will be a lot more efficient.