Automating CSV imports to the same spreadsheet.

Hi there,

I have a series of CSV files which I'd like to collate into one excel worksheet, but I'm struggling to find a pre-written solution. The CSV files are all 2 columns each, with the same number of rows. The first column of each file is identical.

I would like to create a worksheet which has the following format:

- first row contains file name which data came from
- first column contains the first column of first file
- second column contains the second column of first file
- third column contains the second column of second file, etc etc

I've pulled the following code from the web, but I'm not 100% where to start with editing it as I've not used VBA before, so any help would be much appreciated!

cheers,

Jamie

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
#Else
    Private Declare Function SetCurrentDirectoryA Lib _
        "kernel32" (ByVal lpPathName As String) As Long
#End If

Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
    Dim lReturn As Long
    lReturn = SetCurrentDirectoryA(szPath)
    ChDirNet = CBool(lReturn <> 0)
End Function

Sub Get_CSV_Files()
'For Excel 2000 and higher
    Dim Fnum As Long
    Dim mybook As Workbook
    Dim basebook As Workbook
    Dim CSVFileNames As Variant
    Dim SaveDriveDir As String
    Dim ExistFolder As Boolean

    'Save the current dir
    SaveDriveDir = CurDir

    'You can change the start folder if you want for
    'GetOpenFilename,you can use a network or local folder.
    'For example ChDirNet("C:\Users\Ron\test")
    'It now use Excel's Default File Path

    ExistFolder = ChDirNet("D:\GoogleDrive\Projects\Sericin rheology")
    If ExistFolder = False Then
        MsgBox "Error changing folder"
        Exit Sub
    End If

    CSVFileNames = Application.GetOpenFilename _
        (filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)

    If IsArray(CSVFileNames) Then

        On Error GoTo CleanUp

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        'Add workbook with one sheet
        Set basebook = Workbooks.Add(xlWBATWorksheet)

        'Loop through the array with csv files
        For Fnum = LBound(CSVFileNames) To UBound(CSVFileNames)

            Set mybook = Workbooks.Open(CSVFileNames(Fnum))

            'Copy the sheet of the csv file after the last sheet in
            'basebook (this is the new workbook)
            mybook.Worksheets(1).Copy After:= _
                                      basebook.Sheets(basebook.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = Right(CSVFileNames(Fnum), Len(CSVFileNames(Fnum)) - _
                                            InStrRev(CSVFileNames(Fnum), "\", , 1))
            On Error GoTo 0

            mybook.Close savechanges:=False

        Next Fnum

        'Delete the first sheet of basebook
        'On Error Resume Next
        'Application.DisplayAlerts = False
        'basebook.Worksheets(1).Delete
        'Application.DisplayAlerts = True
        'On Error GoTo 0

CleanUp:

        ChDirNet SaveDriveDir

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

Maybe like so:

        On Error Resume Next
        basebook.Sheets(1).Name = Right(CSVFilenames(Fnum), Len(CSVFilenames(Fnum)) - _
                                  InStrRev(CSVFilenames(Fnum), "\", , 1))
        On Error GoTo 0

        For Fnum = LBound(CSVFilenames) To UBound(CSVFilenames)
            Set mybook = Workbooks.Open(CSVFilenames(Fnum))
            If Fnum = LBound(CSVFilenames) Then
                'Copy the sheet of the csv file after the last sheet in
                'basebook (this is the new workbook)
                mybook.Sheets(1).UsedRange.Copy basebook.Sheets(1).Range("A2")
                basebook.Sheets(1).Range("B1").Value = CSVFilenames(Fnum)
            Else
                mybook.Sheets(1).UsedRange.Offset(1).Copy basebook.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Offset(1, 1)
                basebook.Sheets(1).Cells(2, Columns.Count).End(xlToLeft).Offset(-1).Value = CSVFilenames(Fnum)
            End If
            mybook.Close savechanges:=False

        Next Fnum