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

L

LNG2013

Active Member
Joined
May 23, 2011
Messages
465
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

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
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
Domenic said:
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]
Click to expand...



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!

Domenic said:
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.
Click to expand...
 
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
You must log in or register to reply here.

Similar threads

T
  • Question
Loop through folder and copy data into master spreadsheet
Replies
2
Views
281
TaskMaster
T
R
  • Question
VBA Script: Saving worksheet as CSV on MacOS
Replies
1
Views
940
temphelp
T
M
  • Question
Getting Power Query data to an Excel worksheet
Replies
4
Views
207
MichaelMorris
M
C
  • Question
Setting the default save path with prompt
Replies
2
Views
337
CaptainGravyBum
C
B
  • Question
Combining csv sheets to one - code error
2
Replies
10
Views
844
Alex Blakenburg
A

Forum statistics

Threads
1,215,078
Messages
6,122,997
Members
449,093
Latest member
masterms

Share this page

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