Copy range of cells from excel file on SharePoint

Hi,

Try this:-

Function GetDataFrom(SourceFile As Variant, SourceSheet As String, SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long

    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    ' 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
    rsCon.Close
    Set rsCon = Nothing
    Exit Function

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Function

Then for each set you need to grab enter the following:-

'Clear Existing Data but not remove Columns to preserve formulas
    Sheets("Data").Select
    Cells.Select
    Selection.ClearContents
    
    '**************** Update Data ****************
    Sheets("Data").Select
    GetDataFrom "//sites.mysite.net/sites/" & "DataFile.xlsb", "sheetname", "A1:z500", Sheets("Data").Range("A1"), True, True

That should work perfectly...

Ok, So I found a much simpler solution that appears to work thus far. Have a bit more tweaking to do to get it expanded to my full requirements, but below is a sample that works in my test environment:

Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
    Application.ScreenUpdating = False ' turn off the screen updating
    
    Set wb = Workbooks.Open("\\SharePointPath\Testing Source File.xlsx", True, True)
    
    Workbooks("Testing Destination File.xlsm").Worksheets("Sheet1").Range("A1:A2").Value = wb.Worksheets("Sheet1").Range("A1:A2").Value
    
    wb.Close False ' close the source workbook without saving any changes
    
    Set wb = Nothing ' free memory
    
    Application.ScreenUpdating = True ' turn on the screen updating
End Sub