Home > Enterprise >  Merge and filter Multiple CSV files Excel VBA
Merge and filter Multiple CSV files Excel VBA

Time:10-27

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 ?

CodePudding user response:

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

Option Explicit

Sub MergeCSV()

    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, rng As Range
    Dim LastRow As Long, TargetRow As Long, n As Long, r As Long

    ' open new workbook for merged results
    Set wb = Workbooks.Add
    Set ws = wb.Sheets(1)
    TargetRow = 1

    Application.ScreenUpdating = False

    ' 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
        rng.Cells.SpecialCells(xlVisible).Copy

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

        ' remove header unless first file
        If n > 1 Then
            ws.Rows(TargetRow).Delete ' header
        End If
        TargetRow = ws.Cells(Rows.Count, "A").End(xlUp).Row   1

        CSVfile = Dir()
       
    Loop
    Application.ScreenUpdating = True

    ' save merged file
    CSVfile = FOLDER & Format(Now, "yyyymmdd_hhmmss") & "_Merged.csv"
    wb.SaveAs CSVfile, FileFormat:=xlCSV, Local:=True
    wb.Close savechanges:=False

    r = TargetRow - LastRow - 1
    MsgBox n & " Files scanned " & r & " Rows added" & vbLf _
           & " Saved to " & CSVfile, vbInformation
 
End Sub
  • Related