Merge and filter Multiple CSV files Excel VBA

Question

With Excel VBA Code I would like to merge multiple CSV files (; separated) and filter them according to one Column 'Résultat'. So far I can read inside a folder and loop through all files. but my final file (where everything is suppose to be merged, ThisWorkbook.Sheets(1)) is empty at the end :

Dim NameFull As String
Dim NameB As String
 folder_path = "C:\blabla"
 my_file = Dir(folder_path & "*.csv")

 Do While my_file <> vbNullString


 Set target_workbook = Workbooks.Open(folder_path & my_file)
    
    
    RowsInFile = target_workbook.Sheets(1).UsedRange.Rows.Count
    NumOfColumns = target_workbook.Sheets(1).UsedRange.Columns.Count
    
    LastRow = ThisSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    'target_workbook.Worksheets(1).Range("A1").CurrentRegion.Copy data_sheet.Cells(LastRow + 1, "A")
    Set RangeToCopy = target_workbook.Sheets(1).Range(target_workbook.Sheets(1).Cells(RowsInFile, 1), target_workbook.Sheets(1).Cells(RowsInFile, NumOfColumns))
    
     'Range("F1").Copy Destination:=Cells(last_row + 1, "A")
    RangeToCopy.Copy Destination:=ThisWorkbook.Sheets(1).Cells(LastRow + 1, "A")
    target_workbook.Close False
    
    Set target_workbook = Nothing
    
    my_file = Dir()
Loop

I need to save the final merged file in csv (; separated FileFormat:=xlCSV, Local:=True)
PS : Is it possible to only copy specific lines filtering on one column ?

You should determine LastRow based on ThisWorkbook instead of target_workbook. — BigBen
– BigBen, Commented Oct 25, 2021 at 16:12

CDP1802 · Accepted Answer · 2021-10-28 13:47:22Z

1

Amend the constants as required. Merged rows saved to new workbook.

Update 1 Add new sheet if not enough space to paste records.

Option Explicit

Sub MergeCSVtoXLS()

    Const FOLDER = "C:\temp\so\csv\"
    Const FILTER_COL = 1 ' Résultat
    Const FILTER_CRITERIA = ">99"
    
    Dim wb As Workbook, wbCSV As Workbook
    Dim ws As Worksheet, wsCSV As Worksheet
    Dim CSVfile As String, XLSfile As String, LogFile As String
    Dim rng As Range, rngCopy As Range, a
    Dim TargetRow As Long, RowCount As Long
    Dim n As Long, r As Long, i As Long
    
    ' open new workbook for merged results
    Set wb = Workbooks.Add
    Set ws = wb.Sheets(1)
    TargetRow = 1
    i = 1 ' sheet no

    Application.ScreenUpdating = False
    
    ' log file
    LogFile = FOLDER & Format(Now, "yyyymmdd_hhmmss") & ".log"
    Open LogFile For Output As #1
    Print #1, "Folder", FOLDER
    Print #1, "Time", "n", "CSV File", "Rows", "Target Sht", "Target Row"

    ' csv files
    CSVfile = Dir(FOLDER & "*.csv")
    Do While Len(CSVfile) > 0
        n = n + 1
        Set wbCSV = Workbooks.Open(FOLDER & CSVfile, ReadOnly:=True, Local:=True)
        Set wsCSV = wbCSV.Sheets(1)
        Set rng = wsCSV.UsedRange

        ' filter and ropy
        rng.AutoFilter Field:=FILTER_COL, Criteria1:=FILTER_CRITERIA
        Set rngCopy = rng.Cells.SpecialCells(xlVisible)
        
        ' count rows to paste in each non-contig area
        RowCount = 0 '
        For Each a In rngCopy.Areas
            RowCount = RowCount + a.Rows.Count
        Next
        r = r + RowCount - 1
               
        ' check space available on sheet
        If TargetRow + RowCount > ws.Rows.Count Then
             wb.Sheets.Add after:=wb.Sheets(i)
             i = i + 1
             Set ws = wb.Sheets(i)
             TargetRow = 1
        End If
        ' log file
        Print #1, Time, n, CSVfile, RowCount, i, TargetRow

       ' copy paste values
        rngCopy.Copy
        ws.Cells(TargetRow, 1).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        wbCSV.Close savechanges:=False

        ' remove header unless first file
        If TargetRow > 1 Then
            ws.Rows(TargetRow).Delete ' header
        End If
        TargetRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
        ' next file
        CSVfile = Dir()
    Loop
    Close #1
    Application.ScreenUpdating = True
    

    ' save merged file
    XLSfile = FOLDER & Format(Now, "yyyymmdd_hhmmss") & "_Merged.xls"
    wb.SaveAs XLSfile, FileFormat:=xlExcel8, Local:=True ' .xls Excel 97-2003 Workbook
    wb.Close savechanges:=False

    MsgBox n & " Files scanned " & r & " Rows added to " & i & " Sheets" & vbLf _
           & " Saved to " & XLSfile, vbInformation, "See log " & LogFile
 
End Sub

edited Oct 28, 2021 at 13:47

answered Oct 26, 2021 at 11:03

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

14 Comments

Benoît S Over a year ago

Thanks, but it seems that when i copy it doesn't consider columns, I only have rows of 1 column. My CSV is ";" seprated, I can't use the filter as you did

Benoît S Over a year ago

In my csv files some rows contains "," but it shouldn't be considered as a separator. Right now It does separate on the ",". My delimiter is ";" How can I correct it ?

CDP1802 Over a year ago

@Benoît Try adding Local:=True like Workbooks.Open(FOLDER & CSVfile, ReadOnly:=True, Local:=True)

Benoît S Over a year ago

@CD1802 I get an error after a while in the loop : PasteSpecial Has failed. 1004, it says that the zone on the "pasted" sheet isn't the same size as the copy. Is there a way to jump to the next copy ? And keep in memory the failed file ?

CDP1802 Over a year ago

@Benoît Do you have a lot of files and do they have a lot of rows/columns ?

|

Collectives™ on Stack Overflow

Merge and filter Multiple CSV files Excel VBA

1 Answer 1

14 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

14 Comments

Your Answer

Sign up or log in

Post as a guest

Related