Transfer data (Including Null values) from multiple excel sheets into a single repository (Efficient method)

---

Back in July 2018, I demonstrated how to transfer data form multiple spreadsheets into a single repository. While the method I proposed was very effective, it wasn’t very efficient in the sense that it required many lines of code and used to many statements such as “Select”, “Copy”, “paste”, “Offset” which as discussed in previous blogposts tend to slow down the spreadsheets and negatively impact the speed for executing the macro especially when wanting to transfer large volumes of data.

With this is mind and after noticing that a similar macro I had built runs very slowly on windows 10, I came up with an alternative solution which operates perfect for Win 10 operating systems.

We have multiple user forms (Named Form A, Form B, Form C and Form D) and each form consists of two tabs (i.e "Registration Form" and "Order History".

​​We want to transfer values from four of the cells in one tab and one cell in the second tab into another spreadsheet named “Customer Inventory Report”

​The code below takes the 5 values from each input spreadsheet and places them in one row of the output spreadsheet. Pay attention to the parts of the code that are in bold. These are the items that would need to be modified in your code.

Option Explicit
 
Const FOLDER_PATH = "C:\CIS\Forms\"  'REMEMBER END BACKSLASH
 
Sub ImportWorksheets()
 
   Dim sFile As String          
   Dim wsTarget As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim wsSource2 As Worksheet
   Dim wsSource3 As Worksheet
 
   Dim rowTarget As Long         'output row
     
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      
   rowTarget = 5          'The first row to which files will be transferred
  
   'check the folder exists
   If Not FileFolderExists(FOLDER_PATH) Then
      MsgBox "Folder does not exist, enter a valid folder path!"
      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("Customers")
  
   '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
      Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
      Set wsSource = wbSource.Worksheets(1) 'Reference to the "Registration Form" Tab
      Set wsSource2 = wbSource.Worksheets(2) 'Reference to the "Order History" tab
               
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      'import the data
      With wsTarget
  
 .Range("A" & rowTarget).Value = wsSource.Range("D7").Value
 .Range("B" & rowTarget).Value = wsSource.Range("D8").Value                                     
 .Range("C" & rowTarget).Value = wsSource.Range("I7").Value
 .Range("D" & rowTarget).Value = wsSource.Range("I8").Value
.Range("E" & rowTarget).Value = wsSource2.Range("A2").Value                                                                                                                                 
      Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
         '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
       Application.DisplayStatusBar = False
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
errHandler:
   On Error Resume Next
   Application.ScreenUpdating = True
  
   'tidy up
   Set wsSource = Nothing
   Set wbSource = Nothing
   Set wsTarget = Nothing
   'End With
End Sub
    
Private Function FileFolderExists(strPath As String) As Boolean
    If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function


              ****Important notes***

Make sure to make the following adjustments In the code above:

Note#1] The directory for the file in which the spreadsheets are stored must be entered in line 3 of the code with a backlash entered at the end.

​
​Note#2] in the following line of code enter the row number for the first row in the target sheet in which data will be transferred. In the case of this example it is row 5.

​
​Note#3] Indicate the name of the tab on the target sheet in which data is to be transferred

​
​Note#4] Indicate which source sheets need to be selected. For example, wsSource is the first tab and wsSource2 is the second tab as indicated within parenthesis ()

​Note#5] Map the source cells to the destination column as so.

​And here is the outcome of the macro. It runs in with remarkable speed and is perfect for large data sets and the Win10 operating system.