none
Compiling multiple CSV files into a single, new CSV file RRS feed

  • Question

  • Hello,

    I am working on writing a macro to read all .csv files in a directory, copy their contents (minus the header row), and paste them into a new .csv file in the same folder. The code below is my attempt at meeting the following specifications.

    In the meantime, I have another similar project for you – would you please write a macro that similarly aggregates all the files in this folder into one CSV? In this case:

    • Please include columns A, B, & C
    • Every time the macro is run, the file should be saved over when it’s run so the DIA report will be pulling in the same file each time
    • It should be flexible enough that if the names of the files in the folder change, the code can still find them (all the files should always be located in this folder)

    Here is the code I wrote:

    Sub Offers_To_Exclude_Aggregate()
    
    Dim Offers_To_Exclude_Aggregate As Worksheet
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    
    
    
    FolderPath = "\\usilsvr01\lin@mktg\Analytical Services\DIA\Offers Data Question to Exclude"
    
    
    Set Offers_To_Exclude_Aggregate = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    Sheets(1).Name = "Offers To Exclude Aggregate"
    
    
    
    
    Offers_To_Exclude_Aggregate.Range("A1:C1") = Array("Mfg #", "Offer", "Data Question")
    
    NRow = 2
    Dim LastRow As Long
    
        FileName = Dir(FolderPath & "*.csv")
    
        Do While FileName <> ""
            
            ' This report should run on all files in the folder, but a version of this report will already be in the folder, so it should be skipped.
            
            If InStr(1, FileName, "Aggregate") > 0 Then
                FileName = Dir()
                End If
        
            Set WorkBk = Workbooks.Open(FolderPath & FileName)
            
                LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
                    after:=WorkBk.Worksheets(1).Cells.Range("A1"), _
                    SearchDirection:=xlPrevious, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows).Row
                Set SourceRange = WorkBk.Worksheets(1).Range("A2:C" & LastRow)
                    
                ' Set the destination range to start at column A and
                ' be the same size as the source range.
                    
                Set DestRange = Offers_To_Exclude_Aggregate.Range("A" & NRow)
                Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
    
                ' Copy over the values from the source to the destination.
                    
                DestRange.Value = SourceRange.Value
                    
                ' Increment NRow so that data is not overwritten.
                    
                NRow = NRow + DestRange.Rows.Count
                
            ' Close the source workbook without saving changes.
            
            WorkBk.Close savechanges:=False
                
            ' Use Dir to get the next file name.
            
            FileName = Dir()
        Loop
    
    
        ' Call AutoFit on the destination sheet so that all
        ' data is readable.
        Offers_To_Exclude_Aggregate.Columns.AutoFit
        Offers_To_Exclude_Aggregate.Rows.AutoFit
        
        ' Places cursor on the first sell so document doesn't open highlighted or anywhere besides the top
    
        Offers_To_Exclude_Aggregate.Range("A1").Select
        
        
        ' Creates variable to hold SaveAs name for Aggregation Report
        
        Dim workbook_Name As String
    
    
            workbook_Name = "Offers To Exclude Aggregate"
    
    
            ' Saves the workbook in the folder that the data is found in (BE SURE TO CHECK TAHT YOU HAVE THE FOLDER/FILES WITH WHICH YOU SHOULD BE WORKING!!!!)
    
            ActiveWorkbook.SaveAs FileName:=(FolderPath & workbook_Name), FileFormat:=6
    
    
    End Sub

    Yesterday, I wrote a macro to do the same thing, but for .xlsx files. The code above is slightly modified to do this with the .csv files, but when I try and run the macro, I get a run time '1004' error message saying that the file I created may be read-only or encrypted.  Any help in resolving this error message would be greatly appreciated! Thank you!

    UPDATE: I replaced
    Set WorkBk = Workbooks.Open(FolderPath & FileName)
    With
    Set WorkBk = Workbooks.Open(FolderPath & FileName,,,6)
    to specify that the files are .csv, and now I get the error message: Method 'Open'of object 'Worksheets' failed. What am I doing wrong?
    • Edited by Kyle Pekosh Tuesday, August 9, 2016 4:18 PM Update
    Tuesday, August 9, 2016 3:41 PM

Answers

  • I was able to make my macro work by changing 2 things:

    I added a "\" at the end of the file declaration.

    I also flagged ReadOnly as true in the Workbooks.Open line.

    Then, my code ran just as I wanted it to.
    • Marked as answer by Kyle Pekosh Tuesday, August 9, 2016 6:17 PM
    Tuesday, August 9, 2016 6:17 PM

All replies