Data import from closed workbook omits cells

Hello,

I'm using the following code to import data from a sheet in a closed workbook to a sheet in an open workbook:

[VBA]Option Explicit
Sub GetData_ClosedWorkBook()
Dim sh As Worksheet
Dim rDest As Range
Dim SaveDriveDir As String
Dim sPath As String
Dim FName As Variant
Dim N As Long
Dim lNum As Long

SaveDriveDir = CurDir
sPath = Application.DefaultFilePath 'or use "C:\Data"
ChDrive sPath
ChDir sPath

FName = Application.GetOpenFilename(filefilter:="Excel Files,*.xls", _
MultiSelect:=False)
If IsArray(FName) Then

' Sort the Array
FName = Array_Sort(FName)

Application.ScreenUpdating = False
'Add worksheet to the Activeworkbook and use the Date/Time as name
'You can change this to suit
Set sh = ActiveWorkbook.Sheets("Materials")

'Loop through all files you select in the GetOpenFilename dialog
For N = LBound(FName) To UBound(FName)

'create the destination cell address
Set rDest = Range("Materials!A6")
GetData FName(N), "Materials", "B22:H1521", rDest, False, False
Set rDest = Range("Materials!A1508")
GetData FName(N), "Materials", "J22:P221", rDest, False, False
Set rDest = Range("Materials!A1709")
GetData FName(N), "Materials", "R22:X221", rDest, False, False

Next
End If

ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Option Explicit

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
sourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long

If Header = False Then
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
' Create the connection string.
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
End If

szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & sourceRange$ & "];"
On Error GoTo SomethingWrong
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText

'Check to make sure we received data and copy the data
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If

'Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub


Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


Function Array_Sort(ArrayList As Variant) As Variant
Dim aCnt As Integer, bCnt As Integer
Dim tempStr As String
For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
For bCnt = aCnt + 1 To UBound(ArrayList)
If ArrayList(aCnt) > ArrayList(bCnt) Then
tempStr = ArrayList(bCnt)
ArrayList(bCnt) = ArrayList(aCnt)
ArrayList(aCnt) = tempStr
End If
Next bCnt
Next aCnt
Array_Sort = ArrayList
End Function[/VBA]

The problem i'm experiencing, is cells with non-numeric values (i.e., "R820D0") are imported, and cells with numeric values (i.e., "980") are not imported, leaving a blank cell in the destination sheet.

Does anyone have any idea why this is happening? Would really appreciate any help on this.

Thanks!