• DİKKAT

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

Farklı Çalışma Kitabından Veri Alma

Katılım
18 Mart 2012
Mesajlar
440
Excel Vers. ve Dili
2013
Veriyi ekteki çalışma içerisindeki Sayfa1 yerine Farklı bir Çalışma kitabından almasını istiyorum.

Çalışma Kitabının bulunduğu klasör yolu : C:\Users\term\Desktop\Makro Raporlar

Çalışma Kitabının ismi ise: Veri

Not : Şu anki mevcut biçimle "Veri" isimli çalışma kitabındaki biçim aynı. Veri Alırken sadece Sayfa1 yerine Çalışma Kitabını görmesini istiyorum.

Acil lazım bana. Yardımcı olan arkadaşlara şimdiden teşekkürler.

Kod:
Private Sub CommandButton2_Click()
For i = 3 To Sheets("Sayfa1").Cells(Rows.Count, "A").End(3).Row
If Sheets("Sayfa1").Range("E" & i) = "CH Ödeme" Then
chodeme = chodeme + Sheets("Sayfa1").Range("H" & i)
End If
If Sheets("Sayfa1").Range("E" & i) = "CH Tahsilat" Then
chtahsilat = chtahsilat + Sheets("Sayfa1").Range("H" & i)
End If
If Sheets("Sayfa1").Range("E" & i) = "Satınalma Faturası" Then
SatınalmaFaturası = SatınalmaFaturası + Sheets("Sayfa1").Range("H" & i)
End If
If Sheets("Sayfa1").Range("E" & i) = "Satınalma İade Faturası" And (Left(Sheets("Sayfa1").Range("D" & i), 2) = "A-" Or Left(Sheets("Sayfa1").Range("D" & i), 2) = "B-") Then
iade1 = iade1 + Sheets("Sayfa1").Range("H" & i)
End If
If Sheets("Sayfa1").Range("E" & i) = "Satınalma İade Faturası" And (Left(Sheets("Sayfa1").Range("D" & i), 2) = "AN" Or Left(Sheets("Sayfa1").Range("D" & i), 2) = "BN" Or Left(Sheets("Sayfa1").Range("D" & i), 2) = "00") Then
iade2 = iade2 + Sheets("Sayfa1").Range("H" & i)
End If
If Sheets("Sayfa1").Range("E" & i) = "Verilen Hizmet Faturası" Then
hizmet = hizmet + Sheets("Sayfa1").Range("H" & i)
End If
Next
Sheets("Sayfa2").Range("B3").Value = chodeme
Sheets("Sayfa2").Range("B4").Value = chtahsilat
Sheets("Sayfa2").Range("B5").Value = SatınalmaFaturası
Sheets("Sayfa2").Range("B6").Value = iade1
Sheets("Sayfa2").Range("B7").Value = iade2
Sheets("Sayfa2").Range("B8").Value = hizmet
End Sub
 

Ekli dosyalar

kodlarınızı aşağıdaki şekilde değiştirin

Kod:
Private Sub CommandButton2_Click()
    Dim DosyaYoluAdi As String
    Dim Syf As Worksheet
    Dim Dosya As Workbook
    
    DosyaYoluAdi = "C:\Users\term\Desktop\Makro Raporlar.xlsm"
    Set Dosya = Workbooks.Open(DosyaYoluAdi)
    Set Syf = Dosya.Sheets("Sayfa1")
    
    For i = 3 To Syf.Cells(Rows.Count, "A").End(3).Row
        If Syf.Range("E" & i) = "CH Ödeme" Then
            chodeme = chodeme + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "CH Tahsilat" Then
            chtahsilat = chtahsilat + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Satınalma Faturası" Then
            SatınalmaFaturası = SatınalmaFaturası + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Satınalma İade Faturası" And (Left(Syf.Range("D" & i), 2) = "A-" Or Left(Syf.Range("D" & i), 2) = "B-") Then
                iade1 = iade1 + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Satınalma İade Faturası" And (Left(Syf.Range("D" & i), 2) = "AN" Or Left(Syf.Range("D" & i), 2) = "BN" Or Left(Syf.Range("D" & i), 2) = "00") Then
            iade2 = iade2 + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Verilen Hizmet Faturası" Then
            hizmet = hizmet + Syf.Range("H" & i)
        End If
    Next
    Sheets("Sayfa2").Range("B3").Value = chodeme
    Sheets("Sayfa2").Range("B4").Value = chtahsilat
    Sheets("Sayfa2").Range("B5").Value = SatınalmaFaturası
    Sheets("Sayfa2").Range("B6").Value = iade1
    Sheets("Sayfa2").Range("B7").Value = iade2
    Sheets("Sayfa2").Range("B8").Value = hizmet
    Dosya.Close False
End Sub
 
Dalgalıkur hocam teşekkür ederim.

kodları uyguladım ama sonuç alamıyorum. Bir ara Veri dosyasının içeriği ekranda görünüp kayboluyor ama tabloma sonuçları işlemiyor.

iki tabloyuda ekliyorum. Bakabilirseniz sevinirim.

Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
 

Ekli dosyalar

kodları aşağıdaki ile değiştirin

Kod:
Private Sub CommandButton2_Click()
    Dim DosyaYoluAdi As String
    Dim Syf As Worksheet
    Dim Dosya As Workbook
    
    DosyaYoluAdi = "C:\Users\term\Desktop\Makro Raporlar\Veri.xls"
    Set Dosya = Workbooks.Open(DosyaYoluAdi)
    Set Syf = Dosya.Sheets("Sayfa1")
    
    For i = 3 To Syf.Cells(Rows.Count, "A").End(3).Row
        If Syf.Range("E" & i) = "CH Ödeme" Then
            chodeme = chodeme + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "CH Tahsilat" Then
            chtahsilat = chtahsilat + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Satınalma Faturası" Then
            SatınalmaFaturası = SatınalmaFaturası + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Satınalma İade Faturası" And (Left(Syf.Range("D" & i), 2) = "A-" Or Left(Syf.Range("D" & i), 2) = "B-") Then
                iade1 = iade1 + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Satınalma İade Faturası" And (Left(Syf.Range("D" & i), 2) = "AN" Or Left(Syf.Range("D" & i), 2) = "BN" Or Left(Syf.Range("D" & i), 2) = "00") Then
            iade2 = iade2 + Syf.Range("H" & i)
        End If
        If Syf.Range("E" & i) = "Verilen Hizmet Faturası" Then
            hizmet = hizmet + Syf.Range("H" & i)
        End If
    Next
    ThisWorkbook.Sheets("Sayfa2").Range("B3").Value = chodeme
    ThisWorkbook.Sheets("Sayfa2").Range("B4").Value = chtahsilat
    ThisWorkbook.Sheets("Sayfa2").Range("B5").Value = SatınalmaFaturası
    ThisWorkbook.Sheets("Sayfa2").Range("B6").Value = iade1
    ThisWorkbook.Sheets("Sayfa2").Range("B7").Value = iade2
    ThisWorkbook.Sheets("Sayfa2").Range("B8").Value = hizmet
    Dosya.Close False
End Sub
 
Sayın dalgalikur hocam şimdi oldu çalışıyor.

Elinize Sağlık. Çok Teşekkür ederim.

İyi Çalışmalar
 
Geri
Üst