Hi,

My name is Praveen,
I am working on huge data import and need support on macro.
I have a path "C:\Users\ankopr01\Documents\My Received Files" in which 300 plus excel files will be stored, i need to get the data for few specific column
for which headers are matching as per my compilation(also one header column can have multiple headers like city column can be €œTown€�, €œCentre€� €œCity€�, €œLocation€�)from those 300 files, would be possible for anyone help me writing macro.
This also should copy the files name at the end column. you may also write some error & ignore msg if no matching headers found
Below are the requirements
1. This macro should copy the data only for matching headers
2. There should be one more sheet in which error log should be updated(like if headers matched but no data available it should copy the file name in error log stating no data
a. Error log can be updated for headers matched but no data available
b. No headers matched
c. Neither headers matched neither data available
3. Below the headers table

IntervwrDetails_Name : Interviewer's own name (Please fill below details.) IntervwrDetails_ID : Nielsen Interviewer ID (Please fill below details.) StudyID Project Name Tracking / Non Tracking CapiDeviceID : CapiDeviceID. Please enter your device number: CAPIConsoleName : CAPIConsoleName interview_end CAPILastUpdated : CAPILastUpdated Centre name File Name
City Name
Location Name
Town name


I am fine with editing this macro or you can create new macro
Sub GetDataFromFiles()
Dim strFName As String
Dim strPath As String
Dim strWFile As String
Dim wkbkWF As Workbook
Dim wkShtData As Worksheet
Dim wsWF As Worksheet
Dim rngHeaders As Range
Dim rngFile As Range
Dim rngH As Range
Dim rngF As Range
Dim lngR As Long

Application.DisplayAlerts = False

strFName = ActiveWorkbook.Name
Set wkShtData = ThisWorkbook.Worksheets("All Data") 'Change name
Set rngHeaders = wkShtData.Range("A1:J1") 'Header range
Set rngFile = wkShtData.Range("K:K") 'column of filenames
strPath = "C:\Users\shivamkar01\Documents\My Received Files\"
strWFile = Dir(strPath & "*.xls") ' or .xlsx or .xlsm instead of .xls


Do While strWFile < ""
If strWFile < strFName Then
lngR = wkShtData.UsedRange.Rows.Count + 1
Set wkbkWF = Workbooks.Open(strPath & strWFile)
Set wsWF = wkbkWF.Worksheets(1)
For Each rngH In rngHeaders
Set rngF = wsWF.Cells.Find(rngH.Value)
If Not rngF Is Nothing Then
wsWF.Range(rngF(2), wsWF.Cells(wsWF.Rows.Count, rngF.Column).End(xlUp)).Copy _
wkShtData.Cells(lngR, rngH.Column)
End If
Next rngH
If lngR < wkShtData.UsedRange.Rows.Count + 1 Then
rngFile.Cells(lngR).Resize(wkShtData.UsedRange.Row s.Count - lngR).Value = strWFile
End If
wkbkWF.Save
wkbkWF.Close
End If
strWFile = Dir()
Loop

End Sub

Thanks in advance �
Regards,
Praveen Ankolekar