VBA - Combine all new csvs in a folder into one worksheet

LNG2013

Active Member
Joined
May 23, 2011
Messages
466
Hello I need some assistance with some VBA code. I have a folder where new csv' s are always placed. I need to have the csv info copied to a workbook, and then the csv moved to a different folder so the csv is not checked again.

All of the columns are always the same for the csv's.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Try the following macro, which will import CSV files to the active sheet...

Code:
[font=Courier New][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] ImportCSV()

    [color=darkblue]Dim[/color] strSourcePath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strDestPath [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strFile [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strData [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] x [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] r [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] c [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=green]'Change the path to the source folder accordingly[/color]
    strSourcePath = "C:\Path\"
    
    [color=darkblue]If[/color] Right(strSourcePath, 1) <> "\" [color=darkblue]Then[/color] strSourcePath = strSourcePath & "\"
    
    [color=green]'Change the path to the destination folder accordingly[/color]
    strDestPath = "C:\Path\"
    
    [color=darkblue]If[/color] Right(strDestPath, 1) <> "\" [color=darkblue]Then[/color] strDestPath = strDestPath & "\"
    
    strFile = Dir(strSourcePath & "*.csv")
    
    [color=darkblue]Do[/color] [color=darkblue]While[/color] Len(strFile) > 0
        Cnt = Cnt + 1
        r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        [color=darkblue]Open[/color] strSourcePath & strFile [color=darkblue]For[/color] [color=darkblue]Input[/color] [color=darkblue]As[/color] #1
            [color=darkblue]Do[/color] [color=darkblue]Until[/color] EOF(1)
                Line [color=darkblue]Input[/color] #1, strData
                x = Split(strData, ",")
                [color=darkblue]For[/color] c = 0 [color=darkblue]To[/color] [color=darkblue]UBound[/color](x)
                    Cells(r, c + 1).Value = Trim(x(c))
                [color=darkblue]Next[/color] c
                r = r + 1
            [color=darkblue]Loop[/color]
        [color=darkblue]Close[/color] #1
        Name strSourcePath & strFile [color=darkblue]As[/color] strDestPath & strFile
        strFile = Dir
    [color=darkblue]Loop[/color]
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    [color=darkblue]If[/color] Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
 
Upvote 0
Try the following macro, which will import CSV files to the active sheet...

Code:
[FONT=Courier New][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR][/FONT]
 
[FONT=Courier New][COLOR=darkblue]Sub[/COLOR] ImportCSV()[/FONT]
 
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] strSourcePath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] strDestPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] strFile [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] strData [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] x [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] Cnt [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT]
[FONT=Courier New]   [COLOR=darkblue]Dim[/COLOR] c [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT]
 
[FONT=Courier New]   Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR][/FONT]
 
[FONT=Courier New]   [COLOR=green]'Change the path to the source folder accordingly[/COLOR][/FONT]
[FONT=Courier New]   strSourcePath = "C:\Path\"[/FONT]
 
[FONT=Courier New]   [COLOR=darkblue]If[/COLOR] Right(strSourcePath, 1) <> "\" [COLOR=darkblue]Then[/COLOR] strSourcePath = strSourcePath & "\"[/FONT]
 
[FONT=Courier New]   [COLOR=green]'Change the path to the destination folder accordingly[/COLOR][/FONT]
[FONT=Courier New]   strDestPath = "C:\Path\"[/FONT]
 
[FONT=Courier New]   [COLOR=darkblue]If[/COLOR] Right(strDestPath, 1) <> "\" [COLOR=darkblue]Then[/COLOR] strDestPath = strDestPath & "\"[/FONT]
 
[FONT=Courier New]   strFile = Dir(strSourcePath & "*.csv")[/FONT]
 
[FONT=Courier New]   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] Len(strFile) > 0[/FONT]
[FONT=Courier New]       Cnt = Cnt + 1[/FONT]
[FONT=Courier New]       r = Cells(Rows.Count, "A").End(xlUp).Row + 1[/FONT]
[FONT=Courier New]       [COLOR=darkblue]Open[/COLOR] strSourcePath & strFile [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Input[/COLOR] [COLOR=darkblue]As[/COLOR] #1[/FONT]
[FONT=Courier New]           [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] EOF(1)[/FONT]
[FONT=Courier New]               Line [COLOR=darkblue]Input[/COLOR] #1, strData[/FONT]
[FONT=Courier New]               x = Split(strData, ",")[/FONT]
[FONT=Courier New]               [COLOR=darkblue]For[/COLOR] c = 0 [COLOR=darkblue]To[/COLOR] [COLOR=darkblue]UBound[/COLOR](x)[/FONT]
[FONT=Courier New]                   Cells(r, c + 1).Value = Trim(x(c))[/FONT]
[FONT=Courier New]               [COLOR=darkblue]Next[/COLOR] c[/FONT]
[FONT=Courier New]               r = r + 1[/FONT]
[FONT=Courier New]           [COLOR=darkblue]Loop[/COLOR][/FONT]
[FONT=Courier New]       [COLOR=darkblue]Close[/COLOR] #1[/FONT]
[FONT=Courier New]       Name strSourcePath & strFile [COLOR=darkblue]As[/COLOR] strDestPath & strFile[/FONT]
[FONT=Courier New]       strFile = Dir[/FONT]
[FONT=Courier New]   [COLOR=darkblue]Loop[/COLOR][/FONT]
 
[FONT=Courier New]   Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR][/FONT]
 
[FONT=Courier New]   [COLOR=darkblue]If[/COLOR] Cnt = 0 Then _[/FONT]
[FONT=Courier New]       MsgBox "No CSV files were found...", vbExclamation[/FONT]
 
[FONT=Courier New][COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]



Hey Domenic:

This worked like a charm! However is there anyway to only have the first header line show and skipped for all of the other csv's. It's always the first row in all of the csvs.

This would save me from having to go back through and remove all of the other header lines that appear throughout the csv.
 
Upvote 0
Try the following instead...

Code:
Option Explicit

Sub ImportCSV()

    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
    
    'Change the path to the source folder accordingly
    strSourcePath = "C:\Path\"
    
    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
    
    'Change the path to the destination folder accordingly
    strDestPath = "C:\Path\"
    
    If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
    
    strFile = Dir(strSourcePath & "*.csv")
    
    Do While Len(strFile) > 0
        Cnt = Cnt + 1
        [COLOR="Red"]If Cnt = 1 Then
            r = 1
        Else
            r = Cells(Rows.Count, "A").End(xlUp).Row + 1
        End If[/COLOR]
        Open strSourcePath & strFile For Input As #1
            [COLOR="Red"]If Cnt > 1 Then
                Line Input #1, strData
            End If[/COLOR]
            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
        Name strSourcePath & strFile As strDestPath & strFile
        strFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation
    
End Sub

Note that I've made two changes to the code. The first change marked in red was done to avoid having a blank row at the top of your worksheet. The second change marked in red was done according to your request.
 
Upvote 0
That worked amazingly well!
Thank you Domenic!

Try the following instead...

Code:
Option Explicit
 
Sub ImportCSV()
 
    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
 
    'Change the path to the source folder accordingly
    strSourcePath = "C:\Path\"
 
    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
 
    'Change the path to the destination folder accordingly
    strDestPath = "C:\Path\"
 
    If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
 
    strFile = Dir(strSourcePath & "*.csv")
 
    Do While Len(strFile) > 0
        Cnt = Cnt + 1
        [COLOR=red]If Cnt = 1 Then[/COLOR]
[COLOR=red]           r = 1[/COLOR]
[COLOR=red]       Else[/COLOR]
[COLOR=red]           r = Cells(Rows.Count, "A").End(xlUp).Row + 1[/COLOR]
[COLOR=red]       End If[/COLOR]
        Open strSourcePath & strFile For Input As #1
            [COLOR=red]If Cnt > 1 Then[/COLOR]
[COLOR=red]               Line Input #1, strData[/COLOR]
[COLOR=red]           End If[/COLOR]
            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
        Name strSourcePath & strFile As strDestPath & strFile
        strFile = Dir
    Loop
 
    Application.ScreenUpdating = True
 
    If Cnt = 0 Then _
        MsgBox "No CSV files were found...", vbExclamation
 
End Sub

Note that I've made two changes to the code. The first change marked in red was done to avoid having a blank row at the top of your worksheet. The second change marked in red was done according to your request.
 
Upvote 0
Hey Domenic!

Is there a way to do the same thing but instead of pulling all the files in a specific folder, have it pull from one file, and have it append a specidic file everytime? I think this could be done using a copy and paste, omitting the first row from the pull file, and skipping to the last line of the targeted file.
 
Upvote 0
Here's what I saw when pasting the code...the column headers worked fine, but the red data should be on the 2nd row in cell A2. Instead it's showing up as just another column header going across.

"VisitTime" "Profile" "Degree" "First Name" "Middle Name" "Last Name" "From" "Title" "Company" "CompanyProfile" "CompanyWebsite" "Email" "Phone" "IM" "Twitter" "Location" "Industry" "My Tags" """My Notes""
""id.4888851"""

Warren
 
Upvote 0
Good day,

This code really helps, but is there a way to copy the filename into the new sheet containing all the data copied? Thanks
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top