Import multiple csv files in one excel spread sheet - include file name in the first row

Question

Hi,

I am totally new to using VBA in Excel and need your help. Thanks in advance!

I have a folder with multiple .csv files which I need to merge into one excel worksheet.

The file details are as follows:

1. Each file contains two columns of data, the first column is identical in all .csv files. I only need the data from the second columns.
2. all data should be in one data sheet.
3. above each column of data (corresponding to second columns in starting .csv files) should be placed the file name from which that data originates.
4. all starting .csv files are in one folder

Here is the illustration what I expect to achieve:

I found a macros on this website (see below) which almost does what I want, except for putting the names of the starting files in the row 1. What do I need to add it that it also records the file names in the column? Also, when there are multiple files in the folder, which order does the VBA follow in picking .csv files: is it based on the file name or the data it has been created? Huge thanks in advance!

I would greatly appreciate your help,

Kind regards,

Sub GetFromCSVs()

  Dim WB As Workbook

  Dim R As Range

  Dim bFirst As Boolean

  Dim stFile As String

  Dim stPath As String

  stPath = "C:\Temp\CSVs" ' change the path to suit

  stFile = Dir(stPath & "*.csv")

  bFirst = True

  Set R = Workbooks.Add(xlWorksheet).Sheets(1).Range("A1")

  Do Until stFile = ""

    Set WB = Workbooks.Open(stPath & stFile, ReadOnly:=True)

    If bFirst Then

      WB.Sheets(1).Range("A1").CurrentRegion.Copy Destination:=R

      Set R = R.Offset(, 2)

      bFirst = False

    Else

      WB.Sheets(1).Range("A1").CurrentRegion.Columns(2).Copy Destination:=R

      Set R = R.Offset(, 1)

    End If

    WB.Close saveChanges:=False

    stFile = Dir()  ' next file

  Loop

End Sub

Answer 1

Here is a modified version:

Sub GetFromCSVs()

  Dim WB As Workbook

  Dim R As Range

  Dim bFirst As Boolean

  Dim stFile As String

  Dim stPath As String

  stPath = "C:\Temp\CSVs" ' change the path to suit

  stFile = Dir(stPath & "*.csv")

  bFirst = True

  Set R = Workbooks.Add(xlWorksheet).Sheets(1).Range("A1")

  Do Until stFile = ""

    Set WB = Workbooks.Open(stPath & stFile, ReadOnly:=True)

    If bFirst Then

      WB.Sheets(1).Range("A1").CurrentRegion.Columns(1).Copy Destination:=R.Offset(1)

      Set R = R.Offset(, 1)

      bFirst = False

    End If

    R.Value = Left(strfile, Len(strfile) - 4)

    WB.Sheets(1).Range("A1").CurrentRegion.Columns(2).Copy Destination:=R.Offset(1)

    Set R = R.Offset(, 1)

    WB.Close SaveChanges:=False

    stFile = Dir  ' next file

  Loop

End Sub

Answer 2

Hi Hans,

Thanks for very quick answer! Unfortunately, the new script does not work! After I initiate it with F5, it produces Run-time error 5 after opening first .csv file and producing the first column with data. What is wrong there?

Answer 3

Why not use Power Query?

Andreas.

https://www.youtube.com/watch?v=h6vq9NooiHE

Answer 4

Hi Andreas,

Thanks, I tried it. Way more confusing that a good script especially because I sometimes have up to 500 files to process at once.

Any ideas what is wrong with the script above?

Regards,

D.

Answer 5

My apologies, my code had strFile twice where it should have been stFile.

Sub GetFromCSVs()

  Dim WB As Workbook

  Dim R As Range

  Dim bFirst As Boolean

  Dim stFile As String

  Dim stPath As String

  stPath = "C:\Temp\CSVs" ' change the path to suit

  stPath = "C:\Users\gebruiker\Documents\Excel"

  stFile = Dir(stPath & "*.csv")

  bFirst = True

  Set R = Workbooks.Add(xlWorksheet).Sheets(1).Range("A1")

  Do Until stFile = ""

    Set WB = Workbooks.Open(stPath & stFile, ReadOnly:=True)

    If bFirst Then

      WB.Sheets(1).Range("A1").CurrentRegion.Columns(1).Copy Destination:=R.Offset(1)

      Set R = R.Offset(, 1)

      bFirst = False

    End If

    R.Value = Left(stFile, Len(stFile) - 4)

    WB.Sheets(1).Range("A1").CurrentRegion.Columns(2).Copy Destination:=R.Offset(1)

    Set R = R.Offset(, 1)

    WB.Close SaveChanges:=False

    stFile = Dir  ' next file

  Loop

End Sub