Combine 100+ excel csv files with one sheet each into one sheet
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 3 of 3

Thread: Combine 100+ excel csv files with one sheet each into one sheet

  1. #1
    New Member
    Join Date
    Apr 2012
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Combine 100+ excel csv files with one sheet each into one sheet

    Hi all,

    I have 100+ excel csv files with one sheet each with 1000 records in each sheet. First row headers are the same.

    How can I combine them all into one master excel sheet with about 100,000 records?

    These files are all in one folder, distinctly named (11012012180108_1_jllspore, 11012012180108_2_jllspore 11012012180108_3_jllspore) on my C:.

    I can rename them, albeit manually to 1.csv, 2.csv also if required.

    Thanks for all the help.

  2. #2
    MrExcel MVP
    Join Date
    May 2009
    Post Thanks / Like
    11 Post(s)
    0 Thread(s)

    Default Re: Combine 100+ excel csv files with one sheet each into one sheet

    This is untested so may need some tweaking. Note the comments in the code regarding the assumptions that were made. This code should be installed in and run from the master workbook, which should reside in the same folder as the csv files.
    Sub OneHundredPlusToOne()
    'Assumes this macro is in the consolidation workbook
    'Assumes consolidation workbook has headers in row 1, Sheet1 when macro is run
    'Assumes data in csv files is in Sheet1 with headers starting in A1
    Dim nR As Long, fP As String, fNam As String, cBk As Workbook, Sht _
        As Worksheet, Rws As Long
    Const str1 As String = "11012012180108_"
    Const str2 As String = "_jllspore"
    Set cBk = ThisWorkbook
    Set Sht = cBk.Sheets("Sheet1")
    fP = ThisWorkbook.Path & Application.PathSeparator
    For i = 1 To 100  'Change upper limit to match # of csv files in folder
        fNam = fP & str1 & i & str2 & ".csv"
        Workbooks.Open Filename:=fNam
        With ActiveWorkbook.Sheets("Sheet1")
            Rws = .UsedRange.Rows.Count
            .UsedRange.Offset(1, 0).Resize(Rws - 1).Copy
        End With
        With cBk.Sht
            nR = Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & nR).PasteSpecial Paste:=xlValues
            Application.CutCopyMode = False
        End With
        ActiveWorkbook.Close savechanges:=False
    Next i
    End Sub
    Last edited by JoeMo; Dec 14th, 2012 at 11:03 PM.

    When I was a young man I knew everything. Now that I'm older, I realize I know very little, and what I do know, I tend to forget!

  3. #3
    Board Regular
    Join Date
    Jul 2007
    Post Thanks / Like
    1 Post(s)
    0 Thread(s)

    Default Re: Combine 100+ excel csv files with one sheet each into one sheet

    Here's my attempt:

    Option Explicit
    Sub ImportCSVFiles()
        Dim strFolderName As String, _
            strFileName As String
        Dim wbkThisWbk As Workbook, _
            wbkMyCSVFile As Workbook
        Dim shtMyTab As Worksheet
        Dim lngMyRow As Long, _
            lngMyCol As Long, _
            lngPasteRow As Long
        Dim strMyCol As String
        Dim blnIncludeHeader As Boolean
        Dim xlnCalcMethod As XlCalculation
        Set wbkThisWbk = ThisWorkbook
        Set shtMyTab = ActiveSheet 'Imports the data into the activesheet. Change to suit i.e. to import into Sheet1 use this: Set shtMyTab = Sheets("Sheet1")
        blnIncludeHeader = True
        With Application
            xlnCalcMethod = .Calculation
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            .StatusBar = "Please wait while the files are imported..."
        End With
        'Initialise the following varibales to the first *.csv file in the designated folder
        strFolderName = "C:\CSVImportTest\" 'Folder name containing the files. Change to suit, but don't forget the trailing backslash!!
        strFileName = Dir(strFolderName & "*.csv") 'File types to import
        Do Until strFileName = ""
            Set wbkMyCSVFile = Workbooks.Open(strFolderName & strFileName)
            'As a comma separated value file can only have one tab, it's OK to simply use the first sheet via index 1
            With wbkMyCSVFile.Sheets(1)
                If WorksheetFunction.CountA(.Cells) > 0 Then
                    lngMyRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    lngMyCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
                    strMyCol = Left(Cells(1, lngMyCol).Address(True, False), Application.WorksheetFunction.Search("$", Cells(1, lngMyCol).Address(True, False)) - 1)
                    If blnIncludeHeader = True Then
                        .Range("A1:" & strMyCol & lngMyRow).Copy
                        .Range("A2:" & strMyCol & lngMyRow).Copy
                    End If
                    If blnIncludeHeader = True Then
                        Range("A1").PasteSpecial xlPasteValues
                        lngPasteRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Range("A" & lngPasteRow).PasteSpecial xlPasteValues
                    End If
                End If
            End With
            Application.DisplayAlerts = False
                wbkMyCSVFile.Close SaveChanges:=False
            Application.DisplayAlerts = True
            strFileName = Dir()
            blnIncludeHeader = False
        With Application
            .Calculation = xlnCalcMethod
            .StatusBar = ""
            .ScreenUpdating = True
        End With
       MsgBox "Files have now been imported."
    End Sub


User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts