Hi,
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
[ATTACH=CONFIG]69098[/ATTACH]
Code
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