(code adjustment needed) Importing data from multiple .csv files to individual column entries

[Itshouldbeonebutton]

Greetings,
I have been searching for several days now trying to get some answers but to no avail, the closest scripts I have seen have come from this forum. I started trying to learn VB, enough so I could understand and edit but I swear actual code feels like its written backward and upside down compared to tutorials.
I am trying to pull one Column of data (Q1:Q1000) from MULTIPLE .csv files (all stored in one folder into a single spreadsheet page. I found a script that sort of works, but it pulls that data into 1 column. So instead of roughly (25) 1000 entry columns I have (1) 25000 entry column. I spent ages tinkering with the code but the syntax and structuring is foreign to me. In addition to having it paste the range from each .csv into individual columns, I'd like to modify the code to only pull values from selected files (dialog box) rather than just all .csv in a folder, which I found 2 scripts that sort of do it but don't actually work to pull data from. I have posted those scripts as well as it may lessen the workload of anyone that chooses to help. If I can just get the code altered to post into multiple columns that's a win, if we can do the dialog modification I would be over the moon.

Quick notes:
Excel in Microsoft 365.
I did change the user name from my actual name to "*user*" which may or may not work, bot otherwise left the file structure alone.



Working Code that pulls data but stacks in one column and does not have a prompt box:
Sub ExtractDataMuilpleFiles()
Dim location As String, files As String
Dim eFiles() As String
Dim rowCount As Long, fileNum As Long
Dim wBook As Workbook, masterSheet As Worksheet
Dim srcRng As Range, dstRng As Range
Dim rowNum As Long, calType As Long
' Put the folder location
location = "C:\Users\*user*\Desktop\WIND MACRO\Sample Dataset\NWT FL11"
' This will put a Slash if necessary
If Right(location, 1) <> "\" Then
location = location & "\"
End If
files = Dir(location & "*.csv")
If files = "" Then
MsgBox "Not Found"
Exit Sub
End If
fileNum = 0
Do While files <> ""
fileNum = fileNum + 1
ReDim Preserve eFiles(1 To fileNum)
eFiles(fileNum) = files
files = Dir()
Loop
With Application
calType = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set masterSheet = ActiveWorkbook.ActiveSheet
rowNum = 1
If fileNum > 0 Then
For fileNum = LBound(eFiles) To UBound(eFiles)
Set wBook = Nothing
On Error Resume Next
Set wBook = Workbooks.Open(location & eFiles(fileNum))
On Error GoTo 0
If Not wBook Is Nothing Then
On Error Resume Next
' Put the Range to Extract Data from
With wBook.Worksheets(1)
Set srcRng = .Range("Q1:Q1000")
End With
If Err.Number > 0 Then
Err.Clear
Set srcRng = Nothing
Else
If srcRng.Columns.Count >= masterSheet.Columns.Count Then
Set srcRng = Nothing
End If
End If
On Error GoTo 0
If Not srcRng Is Nothing Then
rowCount = srcRng.rows.Count
If rowNum + rowCount >= masterSheet.rows.Count Then
MsgBox "Not enough rows in target worksheet."
masterSheet.Columns.AutoFit
wBook.Close savechanges:=False
GoTo ExitTheSub
Else
Set dstRng = masterSheet.Range("A" & rowNum)
With srcRng
Set dstRng = dstRng. _
Resize(.rows.Count, .Columns.Count)
End With
dstRng.Value = srcRng.Value
rowNum = rowNum + rowCount
End If
End If
wBook.Close savechanges:=False
End If
Next fileNum
masterSheet.Columns.AutoFit
End If
ExitTheSub:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calType
End With
End Sub



I believe this is the portion of code that opens a dialog box to choose files:
Sub Button1_Click()
' choose LOAD path
objFile = Application.GetOpenFilename(fileFilter:="All Files (* . *) , * . * ") ' browse function

Set curSheet = ActiveSheet
Set mWorkbook = Workbooks.Open(objFile)
curSheet.Activate

Call someFunction(curSheet, mWorkbook)
End Sub


Sub someFunction(targetSheet, srcWorkbook)
numSheets = srcWorkbook.Sheets.Count
For i = 1 To numSheets
targetSheet.Cells(i, 1) = srcWorkbook.Sheets(i).Name
Next i
End Sub

This macro also has a prompt according to the guide but I cant make it work:
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
SetCurrentDirectoryA szPath
End Sub
Sub ExtractDataFromSelectedFiles()
Dim eLocation As String
Dim rowCount As Long, filesNum As Long
Dim wBook As Workbook, masterSheet As Worksheet
Dim srcRng As Range, dstRng As Range
Dim rowNum As Long, calType As Long
Dim saveLocation As String
Dim fileName As Variant
With Application
calType = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
saveLocation = CurDir
' Change this to the path\folder location of the files.
ChDirNet "D:\saledata"
fileName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True)
If IsArray(fileName) Then
Set masterSheet = ActiveWorkbook.ActiveSheet
rowNum = 1
For filesNum = LBound(fileName) To UBound(fileName)
Set wBook = Nothing
On Error Resume Next
Set wBook = Workbooks.Open(fileName(filesNum))
On Error GoTo 0
If Not wBook Is Nothing Then
On Error Resume Next
With wBook.Worksheets(1)
Set srcRng = .Range("A1:E4")
End With
If Err.Number > 0 Then
Err.Clear
Set srcRng = Nothing
Else
If srcRng.Columns.Count >= masterSheet.Columns.Count Then
Set srcRng = Nothing
End If
End If
On Error GoTo 0
If Not srcRng Is Nothing Then
rowCount = srcRng.rows.Count
If rowNum + rowCount >= masterSheet.rows.Count Then
MsgBox "not enough rows in target worksheet."
masterSheet.Columns.AutoFit
wBook.Close savechanges:=False
GoTo ExitTheSub
Else
Set dstRng = masterSheet.Range("A" & rowNum)
With srcRng
Set dstRng = dstRng. _
Resize(.rows.Count, .Columns.Count)
End With
dstRng.Value = srcRng.Value
rowNum = rowNum + rowCount
End If
End If
wBook.Close savechanges:=False
End If
Next filesNum
masterSheet.Columns.AutoFit
End If
ExitTheSub:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = calType
End With
ChDirNet saveLocation
End Sub

 

[DanteAmor]

Hi @Itshouldbeonebutton.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

If I can just get the code altered to post into multiple columns that's a win, if we can do the dialog modification I would be over the moon.

Try the following macro. It includes selecting the files you want. Also, of course, multiple columns.
Just adjust the name of your sheet where you want to paste the data.

Sub Importing_Data_From_Multiple_csv()
  Dim csvfile As Variant
  Dim wBook As Workbook
  Dim sh As Worksheet
  Dim j As Long
  Application.ScreenUpdating = False
 
  Set sh = ThisWorkbook.Sheets("Master")    'Fit to your sheet name
 
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select CSV files"
    .Filters.Add "CSV Files", "*.csv"
    .AllowMultiSelect = True
    .InitialFileName = ThisWorkbook.Path & "\"
    If .Show Then
      For Each csvfile In .SelectedItems
        Set wBook = Workbooks.Open(csvfile)
        j = j + 1
        wBook.Sheets(1).Range("Q:Q").Copy sh.Cells(1, j)
        wBook.Close False
      Next
    End If
  End With

  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

 

[Itshouldbeonebutton]

Hi @Itshouldbeonebutton.

Welcome to the MrExcel forum. Please accept my warmest greetings and sincere hope that all is well.​

Try the following macro. It includes selecting the files you want. Also, of course, multiple columns.
Just adjust the name of your sheet where you want to paste the data.

Sub Importing_Data_From_Multiple_csv()
  Dim csvfile As Variant
  Dim wBook As Workbook
  Dim sh As Worksheet
  Dim j As Long
  Application.ScreenUpdating = False
 
  Set sh = ThisWorkbook.Sheets("Master")    'Fit to your sheet name
 
  With Application.FileDialog(msoFileDialogFilePicker)
    .Title = "Select CSV files"
    .Filters.Add "CSV Files", "*.csv"
    .AllowMultiSelect = True
    .InitialFileName = ThisWorkbook.Path & "\"
    If .Show Then
      For Each csvfile In .SelectedItems
        Set wBook = Workbooks.Open(csvfile)
        j = j + 1
        wBook.Sheets(1).Range("Q:Q").Copy sh.Cells(1, j)
        wBook.Close False
      Next
    End If
  End With

  Application.ScreenUpdating = True
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Cordially
Dante Amor
--------------

That worked perfectly! Wow, and your code makes way more sense! Originally I was planning to run this three times, one on each sheet in the workbook to pull three different columns of data. Q for sheet1 ("RSRP"), R for sheet2 ("RSRQ"), and S for sheet 3 ("SNR"). So I modified the code to this and ran it and it worked. Can you see any issues, O wise codemaster?



Sub Importing_Data_From_Multiple_csv()

Dim csvfile As Variant

Dim wBook As Workbook

Dim sh1 As Worksheet

Dim sh2 As Worksheet

Dim sh3 As Worksheet

Dim j As Long

Application.ScreenUpdating = False



Set sh1 = ThisWorkbook.Sheets("RSRP") 'Fit to your sheet name

Set sh2 = ThisWorkbook.Sheets("RSRQ")

Set sh3 = ThisWorkbook.Sheets("SNR")

With Application.FileDialog(msoFileDialogFilePicker)

.Title = "Select CSV files"

.Filters.Add "CSV Files", "*.csv"

.AllowMultiSelect = True

.InitialFileName = ThisWorkbook.Path & "\"

If .Show Then

For Each csvfile In .SelectedItems

Set wBook = Workbooks.Open(csvfile)

j = j + 1

wBook.Sheets(1).Range("Q:Q").Copy sh1.Cells(1, j)

wBook.Sheets(1).Range("R:R").Copy sh2.Cells(1, j)

wBook.Sheets(1).Range("S:S").Copy sh3.Cells(1, j)

wBook.Close False

Next

End If

End With



Application.ScreenUpdating = True

End Sub