I am new to VBA and If anyone can help, I'd greatly appreciate it. I just need help in simple VBA loop in following code.
I am trying to loop through excel files in a folder and copy specific data from DispForm Worksheet in all files to a new workbook (sheet 2). I have a code which does 50% of the job but I am having difficulty in picking some data and copying it in specific format. Following image shows the Dispform worksheets and format in which data needs to be copied
PLEASE FIND THE ATTACHED IMAGE BELOW
Option Explicit Const FOLDER_PATH = "C:\Temp\" '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 = 2 '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 = Sheets("DispForm") 'EDIT IF NECESSARY 'import the data With wsTarget .Range("A" & rowTarget).Value = wsSource.Range("J3").Value .Range("B" & rowTarget).Value = wsSource.Range("B9").Value .Range("C" & rowTarget).Value = wsSource.Range("C9").Value 'optional source filename in the last column .Range("D" & 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