excel dosyasına baska bir excel dosyasınındaki tablardan veri aktarımı

[electronick]

suan calıstıgım excel dosyasında aynı sütunun alt alta gelen satırlarına baska bir excel dosyanın her tabındaki aynı hücrenin icerigini linklemem gerekiyor nasıl yapabilirim....

örnegin

g100 sütununa ='[BAYBAK analizleri-01.xls]102.300'!$P$44

g101 sütununa bir sonraki tabı ='[BAYBAK analizleri-01.xls]163.700'!$P$44

g102 sütünuna bir sonraki tabı ='[BAYBAK analizleri-01.xls]164.500'!$P$44

yazdırmak gibi

yardım ederseniz sevinirim...

 

[uzmanamele]

sorunuzu tam anlayamadım ama sanırım köprü kurmak istiyorsunuz.
hüçreyi sağ tıklayın, köprü tıklayın, çıkan pencerede bu belgeyi seçin, sayda adını seçin, hücre başvurusu kısmına küprü kurmak istediğiniz hücrenin adresini yazın.

 

[Haluk]

Alternatif:

1) İlk önce bilgisayarınızda D:\TempFolder klasörünü oluşturun ve söz konusu birim fiyatların olduğu dosyayı (BAYBAK analizleri-01.xls) bu klasöre kopyalayın.
Yani, sonuçta D:\TempFolder\BAYBAK analizleri-01.xls şeklinde dosyayı yerleştirin. Bu dosya kapalı durumda olacak, açmanıza gerek yok !

2) Daha sonra aşağıdaki kodları, sizin esas dosyanızda bir modüle yerleştirin ve aşağıdaki GetData isimli prosedürü çalıştırın. Kodların çalışması bitince, kapalı durumdaki D:\TempFolder\BAYBAK analizleri-01.xls dosyasındaki tüm sayfaların P44 hücrelerindeki veriler, aktif dosyanın aktif sayfasında G100 hücresinden başlayarak aşağıya doğru sıralanacaktır. Bu arada hatırlatmakta fayda var, kodları yerleştireceğiniz dosyada VBE kısmında menülerden Tools >> References menüsü ile karşınıza çıkacak pencerede Microsoft ActiveX Data Objects 2.1 Library ve Microsoft ADO Ext. 2.5 for DDL and Security eklentilerini ilave etmelisiniz, yoksa kodlar hata verir.

Sub GetData()
    Dim ShCol As Collection
    Dim MyFile As String, MyPath As String
    Dim i As Integer
    MyPath = "[COLOR=Red][B]D:\TempFolder\[/B][/COLOR]"
    MyFile = "[COLOR=Red][B]BAYBAK analizleri-01.xls[/B][/COLOR]"
    If Dir(MyPath & MyFile) = Empty Then
        MsgBox MyFile & " dosyası bulunamadı !"
        Exit Sub
    End If
    Set ShCol = GetShNames(MyPath & MyFile)
    For i = 1 To ShCol.Count
        MyArg = "'" & MyPath & "[" & MyFile & "]" & ShCol(i) & "'!R44C16"
        Range("G" & 99 + i) = ExecuteExcel4Macro(MyArg)
    Next
    MsgBox "İşlem tamam....."
End Sub
'
Function GetShNames(WBName As String) As Collection
    Dim objConn As ADODB.Connection
    Dim objCat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim sConnString As String
    Dim sSheet As String
    Dim Col As New Collection
    sConnString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & WBName & ";" & _
    "Extended Properties=Excel 8.0;"
    Set objConn = New ADODB.Connection
    objConn.Open sConnString
    Set objCat = New ADOX.Catalog
    Set objCat.ActiveConnection = objConn
        For Each tbl In objCat.Tables
            sSheet = tbl.Name
            sSheet = Application.Substitute(sSheet, "'", "")
            sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
            sSheet = Replace(sSheet, "#", ".")
            On Error Resume Next
            Col.Add sSheet
            On Error GoTo 0
        Next tbl
    Set GetShNames = Col
    objConn.Close
    Set objCat = Nothing
    Set objConn = Nothing
End Function

 

[Haluk]

Merhaba;

Yukarıdaki kodları biraz daha revize ederek dosya şeklinde bu mesaja ekliyorum. Herhangibir referans da eklemenize gerek kalmamıştır. Kodlar biraz daha esnek bir yapıya sahiptir.

Ekli Test.zip dosyasının içindeki Test.xls ve BAYBAK analizleri-01.xls dosyalarını bilgisayarda herhangibir yere yerleştirin. Daha sonra Test.xls dosyasını açın ve sayfa üzerindeki düğmeye tıklayarak, kapalı durumdaki BAYBAK analizleri-01.xls dosyasını gösterin. Sözkonusu veriler Test.xls dosyasında aktif sayfaya aktarılacaktır.

 

[electronick]

ellerine saglık sagolasın da bu bende hata veriyor. bir bakarsan sevinirim..