Diğer sayfadan veri alma

[arrow3441]

Merhabalar ekteki dosyada açıklamayı yaptım . Bakabilirseniz çok sevinirim . Rapor sayfasına veri sayfasından hücredeki değere göre veri almak istiyorum

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Toplam olayını anlamıdığım için onu size bıraktım.
Kodlar büyük/küçük harf duyarlıdır o yüzden isim ya da ay adı yazarken dikkat etmek gerek.
Referanslardan Microsoft Activex Data Objects x.x Library (en büyük değer) seçili olmalı

Sub VeriCek()

'Referanslardan Microsoft Activex Data Objects x.x Library (en büyük  değer) seçili olmalı
    Dim i       As Long
    Dim DB      As Object
    Dim RS      As Object
    Dim SQLStr  As String
    Dim SQLKosul As String
    
    Set DB = CreateObject("adodb.Connection")
    Set RS = CreateObject("adodb.Recordset")
    DB.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & ThisWorkbook.FullName
    RS.CursorLocation = adUseClient
    RS.CursorType = adOpenDynamic
    RS.LockType = adLockOptimistic

    Sayfa1.Select   'Sheets("Rapor") yerine yazıldı
    
    Range("A4").CurrentRegion.Offset(1).ClearContents
    
    If Not Range("B2") = "" Then SQLKosul = "TC = " & Range("B2")
    
    If Not Range("C2") = "" Then
        If SQLKosul = "" Then
            SQLKosul = " [Adı Soyadı] = '" & Range("C2") & "'"
        Else
            SQLKosul = SQLKosul & " AND '" & Range("C2") & "'"
        End If
    End If
    
    If Not Range("D2") = "" Then
        If SQLKosul = "" Then
            SQLKosul = " [Ay] = '" & Range("D2") & "'"
        Else
            SQLKosul = SQLKosul & " AND Ay = '" & Range("D2") & "'"
        End If
    End If
    
    If Not SQLKosul = "" Then SQLKosul = "WHERE " & SQLKosul
    
    SQLStr = "SELECT TC,[Adı Soyadı],Şube,[Bu Ay İşe Girmişse Tarihi], FİRMA, NORMAL,[YILLIK İZİN],[ÜCRETSİZ İZİN], RAPORLU, [HAFTALIK İZİN],Yıl, Ay FROM [Veri$] " & SQLKosul

    RS.Open SQLStr, DB, adOpenDynamic, adLockPessimistic, -1
    
    If RS.RecordCount > 0 Then
        Range("B5").CopyFromRecordset RS
        Range("A5") = 1
        i = Cells(Rows.Count, "B").End(3).Row
        Range("A5:A" & i).DataSeries
        MsgBox RS.RecordCount & " Adet Kayıt Bulundu...."
    Else
        MsgBox "Kayıt Bulunamadı...."
    End If
    
    DB.Close
    
    Set DB = Nothing
    Set RS = Nothing
    
End Sub

 

[arrow3441]

Necdet hocam sorunsuz çalışıyor .Elinize sağlık dediğiniz gibi ufak büyük harfe dikkat etmek gerekiyor peki diyelim veri bulamadı hocam uyarı verdirebilirme olabilirmi

 

[Necdet]

Merhaba,
Kodları yeniledim, tekrar kopyalayınız.

 

[arrow3441]

Teşekkür ederim hocam elinize sağlık allah razı olsun

 

[Necdet]

Güle güle kullanın.