Import multiple csv files into separate columns in a worksheet

[anastasia1428]

I have 54 csv files and I want to import into a single worksheet. All files have the same values for column A.
So I want to make a summary that looks like this. Can you help me with the code please?

 

[Zot]

Hi Zot

I was able to fix the error but when I tired to run the macro it copied Column A of each csv files instead.. See Columns C-G below..... It was supposed to copy the Column B of each files
View attachment 37733

My bad. I forgot that you need column B. Let me modify a bit

 

[Zot]

I did not try but I think this should work

Sub GetLastRow()

Dim SelectFolder As Integer
Dim x As Long
Dim strPath As String
Dim wsSummary As Worksheet
Dim wb As Workbook
Dim FSOLibrary As FileSystemObject
Dim FSOFolder As Object
Dim sFileName As Object

Set wsSummary = Sheet1
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show

If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Application.ScreenUpdating = False
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(strPath)

x = 1
'Loop through each file in a folder
For Each sFileName In FSOFolder.Files
    Set wb = Workbooks.Open(sFileName)
    If x = 1 Then
        wb.Sheets("Sheet1").Range("A1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x)
        x = x + 1
    Else
        wb.Sheets("Sheet1").Range("B1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x)
    End If
    x = x + 1
    wb.Close True
Next

Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Application.ScreenUpdating = True

End Sub

 

[anastasia1428]

I did not try but I think this should work

Sub GetLastRow()

Dim SelectFolder As Integer
Dim x As Long
Dim strPath As String
Dim wsSummary As Worksheet
Dim wb As Workbook
Dim FSOLibrary As FileSystemObject
Dim FSOFolder As Object
Dim sFileName As Object

Set wsSummary = Sheet1
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show

If Not SelectFolder = 0 Then
    strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Application.ScreenUpdating = False
'Set all the references to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(strPath)

x = 1
'Loop through each file in a folder
For Each sFileName In FSOFolder.Files
    Set wb = Workbooks.Open(sFileName)
    If x = 1 Then
        wb.Sheets("Sheet1").Range("A1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x)
        x = x + 1
    Else
        wb.Sheets("Sheet1").Range("B1", wb.Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp)).Copy wsSummary.Cells(1, x)
    End If
    x = x + 1
    wb.Close True
Next

Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Application.ScreenUpdating = True

End Sub

Yesss it worked!! Thank you so much

 

[Zot]

Yesss it worked!! Thank you so much

Glad to be able to help. Nothing to do in office now ?