Soru Açık olan dosyadan veri alırken iki hücrenin verisini toplayarak alabilmek.

[Filose]

Herkese merhaba,

Bir sorunumu bir türlü çözemedim. Açık olan Hesap dosyasının 1. sayfasından sadece 10 hücrenin bilgisini
GGV dosyasının GV-ISL sayfasına alabiliyorum ancak iki ayrı hücreyi toplayarak almam gerekir.

Bu sorunumu çözemedim. Yardımcı olabilecek üstad arkadaşlara şimdiden teşekkür ediyorum.
İlgili açıklama Hesap dosyasında açıklanmıştır.

Sağlıkla kalınız,

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Veri_Al()
    Dim Baglanti As Object, Kayit_Seti As Object, Dosya As String
  
    Dosya = ThisWorkbook.Path & "\Hesap.xls"
  
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
  
    Baglanti.Open "Provider=Microsoft.ACE.OleDb.12.0;Data Source=" & Dosya & _
    ";Extended Properties=""Excel 12.0;Hdr=No"""
  
    Kayit_Seti.Open "Select * From [Sheet1$A4:A4]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("E6") = Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$B5:B5]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("W9") = Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$D8:D8]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("W11") = Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$D11:D11]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("W12") = Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$D15:D15]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("W13") = Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$D22:D22]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("W13") = .Range("W13") + Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$H8:H8]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("AY11") = Kayit_Seti.Fields("F1").Value
        End With
    End If
  
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$H11:H11]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("AY12") = Kayit_Seti.Fields("F1").Value
        End With
    End If
   
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$H16:H16]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("AY13") = Kayit_Seti.Fields("F1").Value
        End With
    End If
   
    Kayit_Seti.Close
   
    Kayit_Seti.Open "Select * From [Sheet1$H21:H21]", Baglanti, 1, 1
  
    If Kayit_Seti.RecordCount > 0 Then
        With Sheets("GV-ISL")
            .Range("AY13") = .Range("AY13") + Kayit_Seti.Fields("F1").Value
        End With
    End If
   
    Kayit_Seti.Close
    Baglanti.Close
  
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
End Sub

 

[Filose]

Sayın Korhan Bey,
Çok güzel olmuş ellerinize yüreğinize sağlık.
Teşekkür eder saygılar sunarım.

Sağlık ve huzurla kalın.

 

[Korhan Ayhan]

Aşağıdaki kodu kullanın.

Döngü metodu ile kodlar kısaltılmıştır.

Option Explicit

Sub Veri_Al()
    Dim Baglanti As Object, Kayit_Seti As Object, Dosya As String
    Dim Sorgulanan_Alan As Variant, Hedef_Alan As Variant, X As Byte
    
    Dosya = ThisWorkbook.Path & "\Hesap.xls"
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
   
    Baglanti.Open "Provider=Microsoft.ACE.OleDb.12.0;Data Source=" & Dosya & _
    ";Extended Properties=""Excel 12.0;Hdr=No"""

    Sorgulanan_Alan = Array("A4:A4", "B5:B5", "D8:D8", "D11:D11", "D15:D15", "D22:D22", "H8:H8", "H11:H11", "H16:H16", "H21:H21")
    Hedef_Alan = Array("E6", "W9", "W11", "W12", "W13", "W13", "AY11", "AY12", "AY13", "AY13")

    For X = LBound(Sorgulanan_Alan) To UBound(Sorgulanan_Alan)
        Kayit_Seti.Open "Select * From [Sheet1$" & Sorgulanan_Alan(X) & "]", Baglanti, 1, 1
        
        If Kayit_Seti.RecordCount > 0 Then
            With Sheets("GV-ISL")
                If X = 5 Or X = 9 Then
                    .Range(CStr(Hedef_Alan(X))) = .Range(CStr(Hedef_Alan(X))) + Kayit_Seti.Fields("F1").Value
                Else
                    .Range(CStr(Hedef_Alan(X))) = Kayit_Seti.Fields("F1").Value
                End If
            End With
        End If
        
        Kayit_Seti.Close
    Next
        
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    Baglanti.Close
   
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
End Sub

 

[Filose]

Korhan Bey çok teşekkür ediyorum.
Tam istediğim gibi olmuş. Ayrıca bu kodlar bir çok yerde de işime yarayacak.
Saygı ve hürmetle.