Importing cell values from multiple workbooks in one folder

[Albertu95]

Hello to all!

I'm trying to make a VBA script that allows me to copy the value of certain cells contained in multiple workbooks in a new workbook. This workbooks will be contained all in one folder.
I started from a VBA code used to import and handle multiple csv files in a folder, importing it in a new workbook well formatted.

The code is this:

Sub ImportCSVData()

Dim wb As Workbook
Dim wbCSV As Workbook
Dim myPath As String
Dim myFile As Variant
Dim fileType As String
Dim i As Integer
Dim Nsheets As Integer

'Get Target Folder Path From User
With Application.FileDialog(msoFileDialogFolderPicker)
       .Title = "Select Source Folder"
       .AllowMultiSelect = False
       .Show
'  changed the following line - added the backslash to the path
       myPath = .SelectedItems(1) & "\"
   End With

'Specify file type
 fileType = "*.csv*"

'Target Path with file type
 myFile = Dir(myPath & fileType)

'Add Target Workbook
Workbooks.Add 'add new excel file
ActiveWorkbook.SaveAs Filename:= _
       myPath & "Total Results.xlsm", FileFormat:= _
       xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'save this new excel file as
Set wb = Workbooks.Open(myPath & "Total Results.xlsm") 'open the workbook just created

'Loop through each Excel file in folder
 Do While myFile <> ""
   Worksheets.Add(Before:=Worksheets("Sheet1")).Name = "measure condition " & i + 1
'changed the following line - from *.csv to myFile ** This was probably what was causing the error
   With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile _
           , Destination:=ActiveSheet.Range("$A$1"))
           .Name = myFile
           .FieldNames = True
           .RowNumbers = False
           .FillAdjacentFormulas = False
           .PreserveFormatting = True
           .RefreshOnFileOpen = False
           .RefreshStyle = xlInsertDeleteCells
           .SavePassword = False
           .SaveData = True
           .AdjustColumnWidth = True
           .RefreshPeriod = 0
           .TextFilePromptOnRefresh = False
           .TextFilePlatform = 850
           .TextFileStartRow = 1
           .TextFileParseType = xlDelimited
           .TextFileTextQualifier = xlTextQualifierDoubleQuote
           .TextFileConsecutiveDelimiter = False
           .TextFileTabDelimiter = False
           .TextFileSemicolonDelimiter = False
           .TextFileCommaDelimiter = True
           .TextFileSpaceDelimiter = False
           .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
           1)
           .TextFileTrailingMinusNumbers = True
           .Refresh BackgroundQuery:=False
       End With
   
   [B16:G143].Select 'number conversion csv values
   With Selection
   .NumberFormat = "General"
   .Value = .Value
   End With 'end number conversion csv values
   
   Dim Vin
   Dim Vout
   Dim Vshu1
   Dim Vshu2
   Dim Pin
   Dim Pout
   
   Vin = Application.WorksheetFunction.Average(Range("B16:B143")) 'make average colums
   Vout = Application.WorksheetFunction.Average(Range("C16:C143"))
   Vshu1 = Application.WorksheetFunction.Average(Range("D16:D143"))
   Vshu2 = Application.WorksheetFunction.Average(Range("E16:E143"))
   Pin = Application.WorksheetFunction.Average(Range("F16:F143"))
   Pout = Application.WorksheetFunction.Average(Range("G16:G143"))
   eff = (Abs(Pout) / Abs(Pin)) * 100
   
   Range("B147").Value = "Vin avg:" ' write results
   Range("C147").Value = Abs(Vin)
   Range("D147").Value = "V"
   
   Range("B148").Value = "Vout avg:"
   Range("C148").Value = Abs(Vout)
   Range("D148").Value = "V"
   
   Range("B149").Value = "Vshu1 avg:"
   Range("C149").Value = Abs(Vshu1)
   Range("D149").Value = "V"
   
   Range("B150").Value = "Vshu2 avg:"
   Range("C150").Value = Abs(Vshu2)
   Range("D150").Value = "V"
   
   Range("B151").Value = "Pin avg:"
   Range("C151").Value = Abs(Pin)
   Range("D151").Value = "W"
   
   Range("B152").Value = "Pout avg:"
   Range("C152").Value = Abs(Pout)
   Range("D152").Value = "W"
   
   Range("B153").Value = "Efficiency:"
   Range("C153").Value = eff
   Range("D153").Value = "%"
   
   i = i + 1
   myFile = Dir
   Cells(1, 1).Select 'deselct used values
   
 Loop
 
 'create table of eff points
 
 Nsheets = Workbooks("Total Results.xlsm").Sheets.Count 'number of sheets used
 
 ActiveWorkbook.Sheets(Nsheets).Cells(2, 1).Value = "Pout [w]"
 ActiveWorkbook.Sheets(Nsheets).Cells(2, 2).Value = "Eff [%]"
 
 For j = 1 To Nsheets - 1
 
 ActiveWorkbook.Sheets(Nsheets).Cells(3 + j, 1).Value = ActiveWorkbook.Sheets(j).Cells(152, 3) 'take Pout average from the j worksheet
 ActiveWorkbook.Sheets(Nsheets).Cells(3 + j, 2).Value = ActiveWorkbook.Sheets(j).Cells(153, 3) 'take eff average from the j worksheet

 
 Next j
 
'create graph
 Sheets(Nsheets).Shapes.AddChart2(-1, xlXYScatterLines).Chart.SetSourceData Source:=Range(Sheets(Nsheets).Cells(3, 1), Sheets(Nsheets).Cells(2 + Nsheets, 2))
 
 
 
 Worksheets(Nsheets).ChartObjects(1).Activate

 With ActiveChart.Axes(xlCategory) 'x axis name
   .HasTitle = True
   With .AxisTitle
       .Caption = "Output Power [W]"
       .Font.Name = "bookman"
       .Font.Size = 10
   End With
 End With

 With ActiveChart.Axes(xlValue) 'y axis name
   .HasTitle = True
   With .AxisTitle
       .Caption = "Efficiency [%]"
       .Font.Name = "bookman"
       .Font.Size = 10
   End With
 End With

 Cells(1, 1).Select 'deselct used values
  
  'Sheets(5).Activate
  'Range("A1").Value = Nsheets
  
  'Sheets("measure condition 1").Activate
  'ActiveSheet.Cells(144, 2).Select
  
  'ActiveWorkbook.Sheets(2).Cells(1,1).Value = ActiveWorkbook.Sheets(1).Cells(2,2)
  
  'Sheets(Nsheets).Activate
  'ActiveSheet.Cells(j + 4, 1).Select
  'ActiveCell.Value = j
  'ActiveSheet.Cells(j + 4, 2).Select
  'ActiveCell.Value = j
  
  'Range(cells(1,1), Cells(2,2)).Select

'Message Box when tasks are completed
  MsgBox "Result Import Complete"

End Sub

What I was trying to do is to use the workbook.open as the ActiveSheet.QueryTables.Add in the previous script. The code that I wrote lead excel in an infinite loop, PLEASE DO NOT RUN IT.
This is what I was trying to do (again DO NOT RUN THIS CODE, LEADS TO AN INFINITE LOOP):

Public Sub open_res()

Dim wbr As Workbook

'Get Target Folder Path From User
With Application.FileDialog(msoFileDialogFolderPicker)
      .Title = "Select Source Folder"
      .AllowMultiSelect = False
      .Show
'  changed the following line - added the backslash to the path
      myPath = .SelectedItems(1) & "\"
End With

'Specify file type
fileType = "*.xlsm*"

'Target Path with file type
myFile = Dir(myPath & fileType)

'Add Target Workbook
Workbooks.Add 'add new excel file
ActiveWorkbook.SaveAs Filename:= _
      myPath & "multigraph.xlsm", FileFormat:= _
      xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'save this new excel file as
Set wbr = Workbooks.Open(myPath & "multigraph.xlsm") 'open the workbook just created

Do While myFile <> ""

Workbooks.Open myPath & myFile

Loop

End Sub

I hope I was clear with what I was trying to achieve.
Can somebody help me please?

Do not hesitate to ask clarification please.

 

[alansidman]

Have you considered Power Query

 

[Albertu95]

I think in the first example I posted it uses power query, anyway my problem is to implement the VBA, not to use the GUI.
Thank you for your answer