Hent data fra et excel dokument til et andet

Private Sub BeregnKnap_Click()
   
    PricelistSheetname = ActiveSheet.Range("F2").Value
   
    Dim objAdCon As ADODB.Connection
    Dim objAdRs As ADODB.Recordset
    Dim ConnString As String
   
    Set objAdCon = CreateObject("ADODB.Connection")
   
    objAdCon.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
    PricelistSheetname & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=0;Readonly=True"""
    objAdCon.Open
    If Err <> 0 Then
          MsgBox "Create Connection" + vbCrLf + "Error has occured. Error : " & Err
          Set obj_UDF_getRecordset = Nothing
      Exit Sub
    End If
   
    Set objAdRs = CreateObject("ADODB.Recordset")
    objAdRs.CursorLocation = 3
   
    currentRow = 3
    While ActiveSheet.Range("A" & CStr(currentRow)).Value > ""
        getItemPrice currentRow, objAdCon, objAdRs
        currentRow = currentRow + 1
    Wend
   
    Set objAdRs.ActiveConnection = Nothing
    Set objAdRs = Nothing
   
    objAdCon.Close
    Set objAdCon = Nothing
End Sub

Private Sub getItemPrice(row, cn, rs)

    Dim strSQLStatement As String
    strSQLStatement = "SELECT * FROM varer WHERE varenr = '" + ActiveSheet.Range("A" & CStr(row)).Value + "'"
   
    rs.Open strSQLStatement, cn, 1, 3
    If Err <> 0 Then
        MsgBox "Resultset Open failed: " + strSQLStatement + vbCrLf + "Error has occured. Error : " & Err
        rs.Close
        Exit Sub
    End If
    If rs.EOF = True Then
        MsgBox "Item not found in pricelist: " + vbCrLf + strSQLStatement
        rs.Close
        Exit Sub
    End If
   
    ActiveSheet.Range("C" & CStr(row)).Value = rs.Fields("varetekst").Value
    ActiveSheet.Range("D" & CStr(row)).Value = rs.Fields("varepris").Value
    ActiveSheet.Range("E" & CStr(row)).Value = ActiveSheet.Range("B" & CStr(row)).Value * ActiveSheet.Range("D" & CStr(row)).Value
   
    rs.Close
End Sub