2

I merge all CSV files in a folder into one Excel sheet.

Sub MergeFiles_Click()

    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long
    
    Application.ScreenUpdating = False
    
    strSourcePath = Sheet1.Range("G2").Value
    
    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
    
    strFile = Dir(strSourcePath & "*.csv")
    
    Do While Len(strFile) > 0
        
        Cnt = Cnt + 1
        
        If Cnt = 1 Then
            r = 6
        Else
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If
        
        Open strSourcePath & strFile For Input As #1
        Do Until EOF(1)
            Line Input #1, strData
            x = Split(strData, ",")
            For c = 0 To UBound(x)
                Cells(r, c + 1).Value = Trim(x(c))
            Next c
            r = r + 1
        Loop
            
        Close #1

        strFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation

End Sub

This merges all of the CSV files into one sheet but each CSV file has a header and other info at the top that takes up 12 rows.

I'd like to keep the 12 rows for the first CSV, but remove them from the remaining files prior being put in the Excel sheet.

I want the files to appear as one rather than it look like the files were copied and pasted down the sheet.

Community
  • 1
  • 1
Graham Chandler
  • 175
  • 5
  • 15
  • 1
    You know the data you're working with, but be aware that CSV format generally allows for commas to be embedded within literal strings (fields enclosed in double quotes "like this"). If you get any of those, your code will fail. – Rich Holton Apr 13 '17 at 17:43
  • @RichHolton so after testing this out i found a few instances where this has caused a problem. What can i do to avoid this issue? – Graham Chandler Apr 14 '17 at 15:26
  • 1
    You might find this question/answer helpful: http://stackoverflow.com/questions/12197274/is-there-a-way-to-import-data-from-csv-to-active-excel-sheet – Rich Holton Apr 14 '17 at 15:41
  • @RichHolton i browsed through that post and grabbed the code that uses QueryTables to import a csv and tested it out and it works fine to import one file. How could i rearrange that to go ahead and grab every csv in a folder to achieve what i'm attempting to do? – Graham Chandler Apr 14 '17 at 17:38

2 Answers2

4

The simplest change to your existing code is to just include code to only copy the first 12 rows if Cnt is 1, otherwise ignore them:

Sub MergeFiles_Click()

    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim x As Variant
    Dim Cnt As Long
    Dim r As Long
    Dim c As Long
    Dim inputRow As Long

    Application.ScreenUpdating = False

    strSourcePath = Sheet1.Range("G2").Value

    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"

    strFile = Dir(strSourcePath & "*.csv")

    Do While Len(strFile) > 0

        Cnt = Cnt + 1

        If Cnt = 1 Then
            r = 6
        Else
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If


        Open strSourcePath & strFile For Input As #1
        inputRow = 0
        Do Until EOF(1)
            Line Input #1, strData
            'Maintain a count of how many rows have been read
            inputRow = inputRow + 1
            'Only process rows if this is the first file, or if we have
            'already passed the 12th row
            If Cnt = 1 Or inputRow > 12 Then
                x = Split(strData, ",")
                For c = 0 To UBound(x)
                    Cells(r, c + 1).Value = Trim(x(c))
                Next c
                r = r + 1
            End If
        Loop

        Close #1

        strFile = Dir
    Loop

    Application.ScreenUpdating = True

    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation

End Sub
YowE3K
  • 23,852
  • 7
  • 26
  • 40
0

As Yow E3K says you could just just copy the first twelve lines the first time. My preference would be to put them into to start with by having them on the template and then never copying them.

The code below (from VBA Copy data from an unopened CSV file to worksheet without opening closed CSV - thank you Chancea) has been adapted halfway to start copying at row 2 by putting in .TextFileStartRow = 2

Sub ImportFromCSVWithoutHeaders()

Dim MyDocuments, strFileName, myToday, file, strConnection As String

MyDocuments = Environ$("USERPROFILE") & "\My Documents"
myToday = Format(Date, "mmddyy")
strFileName = "DataFile" & myToday & ".csv"

Dim row As Integer
row = 1
On Error Resume Next
row = Range("A1048576").End(xlUp).row + 1

strConnection = "TEXT;" & MyDocuments & "\DataFolder\" & strFileName

With ActiveSheet.QueryTables.Add(Connection:= _
     strConnection, Destination:=Range("$A$" & row))
    .Name = "temp"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    '.TextFileStartRow = 1
    .TextFileStartRow = 2
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
End Sub
AMF
  • 11
  • Why row 2, OP mentioned 12 row of repetitive data? You need to differentiate the first file from the rest, also suggest to delete the `QueryTable` after `.Refresh` otherwise the size of the workbook might become too big. – EEM Nov 14 '20 at 17:53