• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Excel'de başka bir çalışma kitabından veri almak

Katılım
2 Şubat 2011
Mesajlar
12
Excel Vers. ve Dili
İşte: 2003
Evde: 2007
Arada sırada Open Office
Merhabalar arkadaşlar;

Excel 2003'de bir kod üzerinde çalışıyorum. Amacım, çalıştığım çalışma kitabında bir buton ile başka bir kitaptaki sayfadan veriyi kopyalayarak, çalıştığım kitapta yeni bir sayfaya yazdırmak istiyorum.

Forumda yaptığım araştırmalardan pek bir şey bulamadım. Google sağolsun aşağıdaki kodları buldum ve bir yerlere kadar geldim fakat burada da "Type Mismatch" hatası alıyorum. Veri almak istediğim çalışma kitabında sadece sayılar yok, yazılar da var. Komple 5 sütun, 30 satırı almak istiyorum.

Kod:
Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell
Dim tArray As Variant, r As Long, c As Long
    tArray = ReadDataFromWorkbook("C:xxx.xls", "xxx")
'    For r = LBound(tArray, 2) To UBound(tArray, 2)
'        For c = LBound(tArray, 1) To UBound(tArray, 1)
'            ActiveCell.Offset(r, c).Formula = tArray(c, r)
'        Next c
'    Next r
    ' with transposing
    tArray = Application.WorksheetFunction.Transpose(tArray)
    For r = LBound(tArray, 1) To UBound(tArray, 1)
        For c = LBound(tArray, 2) To UBound(tArray, 2)
            ActiveCell.Offset(r - 1, c - 1).Formula = tArray(r, c)
        Next c
    Next r
End Sub

Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this function can only return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this function can return data from any worksheet in SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName")
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    On Error GoTo 0
    ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Function
InvalidInput:
    MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
    Set rs = Nothing
    Set dbConnection = Nothing
End Function

Sorum anlaşılmadıysa gerekeni cevaplayabilirim.

Yardımcı olabilecek varsa sevinirim.

Kolay gelsin...
 
rs.GetRows'da komutunda sıkıntı var diye tahmin ediyorum.
 
Yukarı...
Hala çözüm bulamadım.
 
Hâlâ bir öneri ya da tavsiye yok sanırım.
Napalım, başka bahara kaldı makro. =)
 
Geri
Üst