Loop Through EXCEL Files and Get Data

Sub GatherData() 
Dim strPath As String
Dim strFileName As String
Dim wb As Workbook
Dim strSource As String
Dim rngSource As Range
Dim rngTarget As Range
Dim intRowCounter As Integer
Dim strTargetFolder As String 
'define where the files are to be copied here (hard coded)
strTargetFolder = "C:\temp" 
'or get the foldername from a ws cell  (uncomment the next line)
'strTargetFolder = ActiveSheet.Range("D1") ' or use a named range 

strSource = "A1"
strPath = ActiveWorkbook.Path
intRowCounter = 1
'this is where the data will be copied to
Set rngTarget = ActiveSheet.Range("A1") 
strFileName = Dir(strPath & "\*.xls") 
'make sure that the target folder name has a trailing slash
If Right(strTargetFolder, 1) <> "\" Then
    strTargetFolder = strTargetFolder & "\"
End If 
Do While strFileName <> ""
    'skip file if it matches the current workbook name
    If strFileName <> ActiveWorkbook.Name Then
        'open the wb
        Set wb = Workbooks.Open(strPath & "\" & strFileName, False, True)
        
        'set range of information to be copied
        Set rngSource = wb.Worksheets(1).Range(strSource)
        
        'copy data from source to target
        rngTarget.Offset(intRowCounter, 0) = rngSource.Value
        rngTarget.Offset(intRowCounter, 1) = rngSource.Offset(0, 1).Value
        'if you want the filename saved in the next column...
        rngTarget.Offset(intRowCounter, 2) = wb.Name
        
        
        'increment target row counter
        intRowCounter = intRowCounter + 1
        
        'close the source workbook with no save
        wb.Close False
        '
        'to do - maybe - test for existence of target folder
        '
        
        'copy the source wb to the target folder
        FileCopy strPath & "\" & strFileName, strTargetFolder & strFileName
        
        '
        'to do - maybe - test for existence of file in new target folder then if found, do the delete
        '  note: don't use the DIR command to test for the file.  It resets the dir list.
        
        'uncomment this line to delete the original - after testing is complete
        'Kill strPath & "\" & strFileName
    
    End If
    
    'get next file name
    strFileName = Dir
Loop 

MsgBox "Done." 
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76: