VBA Code won't loop through all files in the folder

[VioletFlare]

I have a bunch of CSV files in one folder. The aim is to copy all the data (excluding the header row) from each file and collate them into one. Below is the code I'm currently using, the problem is the code only copies data from one file then ends completely ignoring all other files in the folder

Sub get_all_files()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook, Filename As String, Path As String

Dim current_workbook As Workbook, wbk_num_rows As Long, counter As Long, i As Long


Set current_workbook = ActiveWorkbook

Path = current_workbook.Path & "\" 
Filename = Dir(Path & "*.csv")

'--------------------------------------------
'OPEN EXCEL FILES

Application.ScreenUpdating = False

counter = 2

 Do While Len(Filename) > 0  'IF NEXT FILE EXISTS THEN
    
    Set wbk = Workbooks.Open(Path & Filename)

    wbk_num_rows = wbk.Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row ' number of rows in new opened workbook
    
    For i = 2 To wbk_num_rows
        
        Workbooks(current_workbook.Name).Worksheets(1).Range("A" & counter, "AA" & counter) = wbk.Worksheets(1).Range("A" & counter, "AA" & counter).Value
                      
        counter = counter + 1
        
    Next i
    
    wbk.Close True
        
    
    Workbooks(current_workbook.Name).Worksheets(1).Range("A2:O" & counter).WrapText = False
    
    
    Filename = Dir
Loop

Application.ScreenUpdating = True

End Sub

I believe that the problematic line is:

        Workbooks(current_workbook.Name).Worksheets(1).Range("A" & counter, "AA" & counter) = wbk.Worksheets(1).Range("A" & counter, "AA" & counter).Value

I've come to this conclusion because belovw is the code that us to be in use and my code would loop through very folder. Though since making this change it no longer does.

        Workbooks(current_workbook.Name).Worksheets(1).Range("A" & counter) = wbk.Worksheets(1).Range("AA" & i)
        Workbooks(current_workbook.Name).Worksheets(1).Range("B" & counter) = wbk.Worksheets(1).Range("C" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("C" & counter) = wbk.Worksheets(1).Range("D" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("E" & counter) = wbk.Worksheets(1).Range("I" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("G" & counter) = wbk.Worksheets(1).Range("R" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("H" & counter) = wbk.Worksheets(1).Range("W" & i)
        Workbooks(current_workbook.Name).Worksheets(1).Range("J" & counter) = wbk.Worksheets(1).Range("X" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("K" & counter) = wbk.Worksheets(1).Range("Y" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("L" & counter) = wbk.Worksheets(1).Range("A" & i) 
        Workbooks(current_workbook.Name).Worksheets(1).Range("N" & counter) = "Y"

The reason I changed the working code is because I no longer required only certain columns, but instead I need all columns to be copied into the file.

I don't understand why the range change has stopped my program from working as expected . A solution and explanation (if possible) would be much appreciated.

[Richard Buttrey]

Hi,

You need to reset the counter to zero for every new file and change

Workbooks(current_workbook.Name).Worksheets(1).Range("A" & counter, "AA" & counter) = wbk.Worksheets(1).Range("A" & counter, "AA" & counter).Value

to

Workbooks(current_workbook.Name).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Cells(2, 1) = wbk.Worksheets(1).Range("A" & counter, "AA" & counter).Value

However, assuming the rows in the range A1:AA1 in the file being copied are contiguous and to avoid the need for the loop you could simplify this to

Sub get_all_files()
'DECLARE AND SET VARIABLES
    Dim wbk As Workbook, Filename As String, Path As String

    Dim current_workbook As Workbook

    Set current_workbook = ActiveWorkbook

    Path = current_workbook.Path & "\"
    Filename = Dir(Path & "*.csv")


    '--------------------------------------------
    'OPEN EXCEL FILES

    Application.ScreenUpdating = False

    Do While Len(Filename) < 0  'IF NEXT FILE EXISTS THEN

        Set wbk = Workbooks.Open(Path & Filename)
        Application.DisplayAlerts = False
        wbk.Worksheets(1).Range("A1:AA1").CurrentRegion.Copy
        Workbooks(current_workbook.Name).Worksheets(1).Range("A" & Rows.Count).End(xlUp).Cells(2, 1).PasteSpecial (xlPasteValues)
        wbk.Close True
        Filename = Dir
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Workbooks(current_workbook.Name).Worksheets(1).Range("A2:O2").CurrentRegion.WrapText = False
End Sub