Sub paste()
Dim fs, folder, files
Dim errPath As String
Dim filePath As String
Dim iCnt As Integer
Dim iLine As Long
Dim flg As Boolean
Dim temp
iCnt = Cells(1, 2)
errPath = Cells(2, 2)
filePath = Cells(3, 2)
Workbooks.Open filePath
iLine = 0
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.getfolder(errPath)
For i = 1 To iCnt
flg = False
iLine = iLine + 1
Cells(iLine, 1) = "Title"
For Each f In folder.files
temp = Split(f.Name, ".")
If Right(temp(0), 3) = Format(i * 2, "000") Then
iLine = iLine + 1
Cells(iLine, 1) = f.Name
flg = True
Open f.path For Input As #1
Do Until EOF(1)
Line Input #1, strline
temp = Split(strline, ",")
iLine = iLine + 1
For j = 0 To UBound(temp)
Cells(iLine, j + 1) = Replace(temp(j), Chr(34), "")
Next j
Loop
Close #1
End If
Next
If flg = False Then
iLine = iLine + 1
Cells(iLine, 1) = "No File"
iLine = iLine + 5
End If
Next i
End Sub