Copy data from all workbooks in a folder to a summary list

[Foolzrailer]

Hello

I'm trying to copy data from all the workbooks in a folder into a summary workbook.

Basically it needs to look through all the workbooks in the file and from each workbook get the following data:
The data input should start from Row 5, and then move downward.

[TABLE="class: grid, width: 1687, align: left"]
<colgroup><col width="108"><col width="77"><col width="283"><col width="354"><col width="119"><col width="70"><col width="88" span="2"><col width="129"><col width="91"><col width="88"><col width="96" span="2"></colgroup><tbody>[TR]
[TD="width: 108"]A5 = WB1.Sheet1.$C$14
[/TD]
[TD="width: 77"]B5 = WB1.Sheet1.$C$15
[/TD]
[TD="width: 283"]C5 = WB1.Sheet1.$C$13
[/TD]
[TD="width: 91"]J5 = WB1.Sheet1.$I$11
[/TD]
[TD="width: 88"]K5 = WB1.Sheet1.$I$10
[/TD]
[TD="width: 96"]L5 = WB1.Sheet1.$C$40
[/TD]
[TD="width: 96"]M5 = WB1.Sheet1.$E$40
[/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid, width: 1687, align: left"]
<colgroup><col width="108"><col width="77"><col width="283"><col width="354"><col width="119"><col width="70"><col width="88" span="2"><col width="129"><col width="91"><col width="88"><col width="96" span="2"></colgroup><tbody>[TR]
[TD="width: 108"]A5 = WB2.Sheet1.$C$14
[/TD]
[TD="width: 77"]B5 = WB2.Sheet1.$C$15
[/TD]
[TD="width: 283"]C5 = WB2.Sheet1.$C$13
[/TD]
[TD="width: 91"]J5 = WB2.Sheet1.$I$11
[/TD]
[TD="width: 88"]K5 = WB2.Sheet1.$I$10
[/TD]
[TD="width: 96"]L5 = WB2.Sheet1.$C$40
[/TD]
[TD="width: 96"]M5 = WB2.Sheet1.$E$40
[/TD]
[/TR]
</tbody>[/TABLE]




Any help would be much appreciated.

So far I've only figured out how to do it from one activeworkbook, to the same active workbook, which doesn't really cut it.

 

[Foolzrailer]

Tried with this Macro, but nothing happens.

Option Explicit


Const FOLDER_PATH = "C:\Users\JGJ\Desktop\Test Økonomi\"  'REMEMBER END BACKSLASH


Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row
   
   rowTarget = 5
   
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
   
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
   
   'set up the target worksheet
   Set wsTarget = Sheets("Sheet2")
   
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xls*")
   Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY
      
      'import the data
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("C14").Value
         .Range("B" & rowTarget).Value = wsSource.Range("C15").Value
         .Range("C" & rowTarget).Value = wsSource.Range("D13").Value
         .Range("J" & rowTarget).Value = wsSource.Range("I11").Value
         .Range("K" & rowTarget).Value = wsSource.Range("I10").Value
         .Range("L" & rowTarget).Value = wsSource.Range("C40").Value
         .Range("M" & rowTarget).Value = wsSource.Range("E40").Value

         'optional source filename in the last column
         .Range("N" & rowTarget).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
   
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function

 

[Foolzrailer]

I've gotten the following code to return the required values, however I'm wondering if there is a way to paste the values as links instead of value? So if the cells is updated, I just need to refresh to get the new value in my summary sheet?

I think I need to change: wsSource.Range("C14").Value too something else, but I can't figure out what.

Option Explicit


Const FOLDER_PATH = "Filepath\"  'REMEMBER END BACKSLASH

Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long         'output row
   
   rowTarget = 5
   
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Specified folder does not exist, exiting!"
      Exit Sub
   End If
   
   'reset application settings in event of error
   On Error GoTo errHandler
   Application.ScreenUpdating = False
   
   'set up the target worksheet
   Set wsTarget = Sheets("Ark1")
   
   'loop through the Excel files in the folder
   sFile = Dir(FOLDER_PATH & "*.xls*")
   Do Until sFile = ""
      
      'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets("Side 1-Forside") 'EDIT IF NECESSARY
      
      'import the data
      With wsTarget
         .Range("A" & rowTarget).Value = wsSource.Range("C14").Value
         .Range("B" & rowTarget).Value = wsSource.Range("C15").Value
         .Range("C" & rowTarget).Value = wsSource.Range("C13").Value
         .Range("J" & rowTarget).Value = wsSource.Range("I11").Value
         .Range("K" & rowTarget).Value = wsSource.Range("I10").Value
         .Range("L" & rowTarget).Value = wsSource.Range("C40").Value
         .Range("M" & rowTarget).Value = wsSource.Range("E40").Value
         .Range("H" & rowTarget).Value = wsSource.Range("I9").Value
         'optional source filename in the last column
         .Range("AK" & rowTarget).Value = sFile
      End With
      
      'close the source workbook, increment the output row and get the next file
      wbSource.Close SaveChanges:=False
      rowTarget = rowTarget + 1
      sFile = Dir()
   Loop
   
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
   
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
End Sub


Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function