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