excelvbacsvmerge

Merging .CSV files into one Master Workbook


I have multiple .CSV files holding my data. I'm trying to merge them into one master sheet.

The macro stops after opening the first .CSV file in the series. It doesn't error.

There's still a good amount of code I have to write, such as identifying specific columns and rows and grabbing that particular data from each of the sheets.

I have this setup as a template.

I transferred the code to a fresh workbook and it still didn't give me anything.

Option Explicit

Private Sub CommandButton1_Click()
    mergeData
End Sub

Sub mergeData()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    ' Our FileSystem Objects.
    Dim objFs As Object
    Dim objFolder As Object
    Dim file As Object
    
    'Show a pop up to select a folder.
    Dim sPath As String
    sPath = chooseFolder()
    
    Set objFs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFs.GetFolder(sPath)       ' The folder path.
    
    Dim iCnt As Integer
    iCnt = 1
    
    ' Loop through all the files in the folder.
    For Each file In objFolder.Files
    
        Dim objSrc As Workbook      ' The source.
        Set objSrc = Workbooks.Open(file.Path, True, True)
        
        Dim iTotalRows As Integer   ' The total used range in the source file.
        iTotalRows = objSrc.Worksheets("Sheet1").UsedRange.Rows.Count
        
        Dim iTotalCols As Integer   ' Now, get the total columns in the source.
        iTotalCols = objSrc.Worksheets("Sheet1").UsedRange.Columns.Count
        
        Dim iRows, iCols As Integer
        
        ' Read data from source and copy in the master file.
        For iRows = 1 To iTotalRows
            For iCols = 1 To iTotalCols
                Application.Workbooks(1).ActiveSheet.Cells(iRows, iCols) = _
                  objSrc.Worksheets("Sheet1").Cells(iRows, iCols)
                ' Note: It will read data in "Sheet1" of the source file.
            Next iCols
        Next iRows
        
        iRows = 0
        
        ' Get the name of the file (I'll name the active sheet with the filename).
        Dim sSheetName As String
        sSheetName = Replace(objSrc.Name, ".csv", "")          ' Assuming the files are .xlsx files.
        
        ' Close the source file (the file from which its copying the data).
        objSrc.Close False
        Set objSrc = Nothing
        
        With ActiveWorkbook
            .ActiveSheet.Name = sSheetName           ' Rename the sheet.
            iCnt = iCnt + 1
            
            If iCnt > .Worksheets.Count Then
                ' Create or add a new sheet after the last sheet.
                .Sheets.Add After:=.Worksheets(.Worksheets.Count)
            End If
            
            .Worksheets(iCnt).Activate      ' Go to the next sheet.
        End With
    Next
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

' Open file dialog box to select a folder.
Function chooseFolder() As String
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Filters.Clear
        .Title = "Select an Excel File"
        .Filters.Add "Excel Files", "*.csv?", 1
        .AllowMultiSelect = True
        
        Dim sPath As String
    
        If .Show = True Then
            chooseFolder = fd.InitialFileName  ' Get the folder path.
        End If
    End With
End Function

Solution

  • Copy CSV Files to a New Workbook

    Private Sub CommandButton1_Click()
        CopyCsvFilesToNewWorkbook
    End Sub
    
    
    Sub CopyCsvFilesToNewWorkbook()
         
        ' Select the source folder path.
        Dim sPath As String: sPath = GetSelectedFolderPath
        If Len(sPath) = 0 Then Exit Sub ' dialog canceled
        
        Debug.Print "Folder Path: """ & sPath & """"
        
        ' Write the CSV file paths to an array.
        Dim CsvFilePaths As Variant: CsvFilePaths = FilePathsToArray(sPath, "*.csv")
        If IsEmpty(CsvFilePaths) Then Exit Sub ' no files found
        
        Debug.Print "CSV File Paths"
        Debug.Print Join(CsvFilePaths, vbLf)
        
        ' Copy the CSV files to a new workbook.
        Dim dwb As Workbook: Set dwb = CsvFilesToNewWorkbook(CsvFilePaths)
        If dwb Is Nothing Then Exit Sub
        
        Debug.Print "The new workbook '" & dwb.Name & "' contains " _
            & dwb.Worksheets.Count & " worksheets."
        
        ' Continue with saving the workbook... 'dwb.SaveAs...'
        
    End Sub
    
    Function GetSelectedFolderPath( _
        Optional ByVal InitialFolderPath As String = "", _
        Optional ByVal DialogTitle As String = "Browse", _
        Optional ByVal DialogButtonName As String = "OK") _
    As String
        
        Dim FolderPath As String
        Dim Canceled As Boolean
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = DialogTitle
            .ButtonName = DialogButtonName
            Dim pSep As String: pSep = Application.PathSeparator
            If Len(InitialFolderPath) > 0 Then
                FolderPath = InitialFolderPath
                If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
                .InitialFileName = FolderPath
            End If
            If .Show Then
                FolderPath = .SelectedItems(1)
                If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
            Else
                Canceled = True
            End If
        End With
        
        If Canceled Then
            MsgBox "Dialog canceled.", vbExclamation, "GetSelectedFolderPath"
            Exit Function
        End If
    
        GetSelectedFolderPath = FolderPath
    
    End Function
    
    Function FilePathsToArray( _
        ByVal SourceFolderPath As String, _
        Optional ByVal FilePattern As String = "*.*") _
    As Variant
        
        Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
        Dim fsoFolder As Object: Set fsoFolder = fso.GetFolder(SourceFolderPath)
        Dim LCaseFilePattern As String: LCaseFilePattern = LCase(FilePattern)
        
        Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
        
        Dim fsoFile As Object
        Dim FilePath As String
        
        For Each fsoFile In fsoFolder.Files
            FilePath = fsoFile.Path
            If LCase(FilePath) Like LCaseFilePattern Then
                dict(FilePath) = Empty
            End If
        Next fsoFile
        
        If dict.Count = 0 Then
            MsgBox "No files found.", vbExclamation
            Exit Function
        End If
        
        FilePathsToArray = dict.Keys
    
    End Function
    
    ' This method is written as a function
    ' to return a reference to the new workbook.
    Function CsvFilesToNewWorkbook( _
        ByVal CsvFilePaths As Variant) _
    As Workbook
    ' It is assumed that none of the CSV files are open in the current application
    ' i.e. if a file is open, modified but not saved, this procedure
    ' will copy the modified file but will also close it without saving the changes.
    ' If a file is open in another application, it might not get copied.
    
        Application.ScreenUpdating = False
    
        Dim swb As Workbook
        Dim sws As Worksheet
        Dim dwb As Workbook
        Dim n As Long
        Dim FilesCount As Long
        Dim FilePath As String
        
        For n = LBound(CsvFilePaths) To UBound(CsvFilePaths)
            FilePath = CsvFilePaths(n)
            On Error Resume Next
                Set swb = Workbooks.Open(FilePath, True, True)
            On Error GoTo 0
            If Not swb Is Nothing Then ' workbook is open
                Set sws = swb.Worksheets(1) ' the one and only
                FilesCount = FilesCount + 1
                If FilesCount = 1 Then ' the first source workbook
                    ' Copy the worksheet to a new workbook.
                    sws.Copy ' creates a new single-worksheet workbook
                    ' Reference this new workbook, the destination workbook.
                    Set dwb = Workbooks(Workbooks.Count)
                Else ' all source workbooks but the first
                    ' Copy the source worksheet to the destination workbook.
                    sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
                End If
                swb.Close SaveChanges:=False
                Set swb = Nothing ' reset
            'Else ' workbook is not open; do nothing
            End If
        Next n
        
        If Not dwb Is Nothing Then
            'dwb.Saved = True ' to easily close while testing
            Set CsvFilesToNewWorkbook = dwb
        End If
        
        Application.ScreenUpdating = True
        
        'MsgBox "Copied " & FilesCount & "(" & n & ")" & " CSV file" _
            & IIf(FilesCount = 1, "", "s") & " to a new workbook.", _
            IIf(FilesCount = 0, vbExclamation, vbInformation), _
            "CsvFilesToNewWorkbook"
        
    End Function