CODEWITHSUNDEEP
excelvbacsvmerge
Benoît S
Benoît S

Reputation: 163

Merge and filter Multiple CSV files Excel VBA

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 ?

Upvotes: 0

Views: 1618

Answers (1)

CDP1802
CDP1802

Reputation: 16357

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

Upvotes: 1

Related Questions