CODEWITHSUNDEEP
vbaexcelcsv
Graham Chandler
Graham Chandler

Reputation: 193

Merging CSVs into one sheet and removing headers

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.

Upvotes: 2

Views: 1883

Answers (2)

AMF
AMF

Reputation: 7

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

Upvotes: 0

YowE3K
YowE3K

Reputation: 23974

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

Upvotes: 4

Related Questions