Combine multiple CSV files automatically instead of using Application.GetOpenFilename

davidp13

New Member
Joined
Jun 7, 2011
Messages
25
Hi. I have a piece of code that helps me select multiple CSV files and then import them into one sheet where I will then run additional scripts to build output data. I'm looking to automate the process more and trying to circumvent the selection of the CSV through the manual process and rather have the script automatically pick up all the files and then import + manipulate as needed.

Below is the code. Can anyone help me change this so that when I execute it, it will choose all the CSV in a folder automatically? Thanks

Code:
Sub Import()    Dim fn, ws As Worksheet, e, flg As Boolean, LastR As Range, wsName As String
   
    fn = Application.GetOpenFilename("Excel(*.csv*),*.csv*", MultiSelect:=True)
    
    If Not IsArray(fn) Then Exit Sub
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Application.ScreenUpdating = False
    ws.Cells.Clear
    For Each e In fn
        With Workbooks.Open(e)
            With .Sheets(1)
                wsName = .Name
                If Not flg Then
                    .Rows(1).Copy ws.Cells(1)
                    ws.Columns(1).Insert
                    ws.Cells(19).Value = "Sheet name"
                    flg = True
                End If
                Set LastR = ws.Cells(Rows.Count, 2).End(xlUp)(2)
                With .Range("a1").CurrentRegion
                    With .Resize(.Rows.Count - 1).Offset(1)
                        .Copy LastR
                        LastR(, 18).Resize(.Rows.Count).Value = _
                            CreateObject("Scripting.FileSystemObject").GetBasename(e)
                    End With
                End With
            End With
            .Close False
        End With
    Next
    Sheets("Sheet1").Range("A:A").EntireColumn.Delete
    ws.Range("a1").CurrentRegion.Columns.AutoFit
    Application.ScreenUpdating = True
    Set ws = Nothing
End Sub
 
Last edited:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Hi, I read through this thread. Used the code, but on my macro it does not pull through the .csv file name into a relevant column. I'm new to VBA and finding my way around, so please pardon my ignorance. Please see the code below used and then made the amendment as highlighted for the File name, merges perfectly, but no column inserted allocated each file name to the relevant rows.

Could it be because of Excel 2016? Trying a shot in the dark. Merging sheets is not new to me and i tried my excel merges as for that i always get the file name to be inserted as a column when copying the data, but for this , it does not want to work?

Thanks In Advance.
 
Upvote 0
Apologies,

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
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
ws.Cells.Clear

'Change the path to the source folder accordingly
strSourcePath = "C:\Users\lovin.coetzee\Documents\GSK\Timesheets"

If Right(strSourcePath, 1) <> "" Then strSourcePath = strSourcePath & ""

'Change the path to the destination folder accordingly
strDestPath = "C:\Users\lovin.coetzee\Documents\GSK\Merged Sheets"

If Right(strDestPath, 1) <> "" Then strDestPath = strDestPath & ""

strFile = Dir(strSourcePath & "*.csv")

Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1 , strData

End If
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))
ws.Cells(r, 18).Value = strFile
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
 
Upvote 0
It copies the .csv part of the filename as well and I only want the name excluding the suffix. the object way is a bit slower so i'm open to any suggestions it more efficient. Thanks

I've been enjoying the PowerQuery in 2013, Get and Transform in 2016, which allows bringing in files from folders and handling all the parsing when necessary.
There are some things that remain troublesome, but haven't completely thwarted me yet.

Example. I have a folder with monthly reports for two years. I use PowerQuery to bring those files ( .txt files) in to Excel's Data Model and then analyze in a Pivot Table. About two million records. The bosses ask a question and the data is already compiled. Rearrange the Pivot Table an done in five to ten minutes. Everyone else (here) would try and run a new set of reports or ask IT to do it (and wait on IT's schedule.)
 
Upvote 0
It should be putting the file name in the 18th column, per this line here:
Code:
[COLOR=#333333]ws.Cells(r, 18).Value = strFile[/COLOR]
 
Upvote 0
Understood.... I changed it to (r,20) as last info pulls through to column 19. Not working, thanks.
 
Upvote 0
You are missing the slashes at the end of your filepaths:
Code:
[COLOR=#333333]'Change the path to the source folder accordingly[/COLOR]
[COLOR=#333333]strSourcePath = "C:\Users\lovin.coetzee\Documents\GSK\Timesheets[/COLOR][COLOR=#ff0000]\[/COLOR][COLOR=#333333]"[/COLOR]

[COLOR=#333333]If Right(strSourcePath, 1) <> "" Then strSourcePath = strSourcePath & ""[/COLOR]

[COLOR=#333333]'Change the path to the destination folder accordingly[/COLOR]
[COLOR=#333333]strDestPath = "C:\Users\lovin.coetzee\Documents\GSK\Merged Sheets[/COLOR][COLOR=#ff0000]\[/COLOR][COLOR=#333333]"[/COLOR]
 
Upvote 0
Thank you , made the changes, still merges without file name. Code works and it skipped headers from 2nd file onwards as it should, I am happy with how it merges, just that it does not pull the file name to the column. I pasted the code in a macro workbook as the objective is to once the file is merged, to convert it to an import file, the merge is the first part.
 
Upvote 0
I tested it out the code and it worked for me, so I do not know what you are doing differently.
Maybe it has something to do with the data in your files.
 
Upvote 0

Forum statistics

Threads
1,224,828
Messages
6,181,201
Members
453,022
Latest member
RobertV1609

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