• DİKKAT

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

Sayfalar Arası Veri Aktarımı

R

rhombeus

Katılım
23 Aralık 2009
Mesajlar
114
Excel Vers. ve Dili
Excel 2003
Değerli Hocalar Merhabalar,

Ekte bir dosyamda GENEL HAFTALIK çalışma sayfasında uzunca bir veri listesi var. Bu listedeki müşterilerin verilerinin rapor sayfasındaki formata aktarmak istiyorum.

Örneğin: Müşteri Adı: ad1 olan müşterinin. Rapor sayfasında Satış, CH, Firma Çeki, Müşteri Çeki sutünlarındaki ilgili yerlerine getirmem gerekmekte. Rapor sayfasında ki 27, 28 ... şeklinde giden sutün başlıkları haftaları temsil etmekte.

Yardımcı olabilirseniz çok sevinirim. Saygılarımı sunarım.

İyi günler
 

Ekli dosyalar

Hocalarım fikir verebilecek veya yardım edebilecek kimse yok mu ?
 
ekli dosyayı bir kontrol ediniz.


Kod: 
Sub aktar()
Sheets("RAPOR").Rows("3:6").ClearContents
Sheets("RAPOR").Cells(3, 1).Value = "SATIŞ"
Sheets("RAPOR").Cells(4, 1).Value = "CH"
Sheets("RAPOR").Cells(5, 1).Value = "FİRMA ÇEKİ"
Sheets("RAPOR").Cells(6, 1).Value = "MÜŞTERİ ÇEKİ"
aranan1 = Sheets("RAPOR").Cells(1, "A").Value
For r = 3 To 27
If Sheets("RAPOR").Cells(1, "A").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("GENEL HAFTALIK").Range("C2:C" & r), aranan1) = 1 Then
For i = r To 27
sat = 2
aranan2 = Sheets("GENEL HAFTALIK").Cells(i, 3).Value
If aranan2 = aranan1 Then
For n = 5 To Worksheets("GENEL HAFTALIK").Cells(2, 255).End(xlToLeft).Column
Sheets("RAPOR").Cells(3, sat).Value = CDbl(Sheets("RAPOR").Cells(3, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n).Value)
Sheets("RAPOR").Cells(4, sat).Value = CDbl(Sheets("RAPOR").Cells(4, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 1).Value)
Sheets("RAPOR").Cells(5, sat).Value = CDbl(Sheets("RAPOR").Cells(5, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 2).Value)
Sheets("RAPOR").Cells(6, sat).Value = CDbl(Sheets("RAPOR").Cells(6, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 3).Value)
sat = sat + 1
n = n + 3
Next n
End If
Next i
End If
End If
Next r
MsgBox "işlem tamam"
End Sub
 

Ekli dosyalar

Hocam çok teşekkür ederim ellerinize sağlık.

Saygılarımla.
 
Bir sorum olacak. Müşteriyi RAPOR sayfasında combobox ile seçiyoruz. Seçtirme olayı olmadığını düşünelim. Tabloları tek tek (araya 10 satır boşluk gelecek şekilde) bütün müşteriler için yapabilirmiyiz?
 
Son düzenleme:
rhombeus' Alıntı:
Bir sorum olacak. Müşteriyi RAPOR sayfasında combobox ile seçiyoruz. Seçtirme olayı olmadığını düşünelim. Tabloları tek tek (araya 10 satır boşluk gelecek şekilde) bütün müşteriler için yapabilirmiyiz?
Genişletmek için tıkla ...

bu kodu denermisiniz.

Kod: 
Sub aktar()
Sheets("RAPOR").Rows("3:1000").ClearContents
sat1 = 3
For J = 3 To 27
aranan1 = Sheets("GENEL HAFTALIK").Cells(J, "C").Value
son = 0
For r = 3 To 27
If Sheets("RAPOR").Cells(1, "A").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("GENEL HAFTALIK").Range("C2:C" & r), aranan1) = 1 Then
For i = r To 27
sat = 2
aranan2 = Sheets("GENEL HAFTALIK").Cells(i, 3).Value
If aranan2 = aranan1 Then
Sheets("RAPOR").Cells(sat1, 1).Value = aranan1 & "  SATIŞ"
Sheets("RAPOR").Cells(sat1 + 1, 1).Value = "CH"
Sheets("RAPOR").Cells(sat1 + 2, 1).Value = "FİRMA ÇEKİ"
Sheets("RAPOR").Cells(sat1 + 3, 1).Value = "MÜŞTERİ ÇEKİ"
For n = 5 To Worksheets("GENEL HAFTALIK").Cells(2, 255).End(xlToLeft).Column
Sheets("RAPOR").Cells(sat1, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n).Value)
Sheets("RAPOR").Cells(sat1 + 1, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 1, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 1).Value)
Sheets("RAPOR").Cells(sat1 + 2, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 2, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 2).Value)
Sheets("RAPOR").Cells(sat1 + 3, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 3, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 3).Value)
sat = sat + 1
n = n + 3
son = 1
Next n
End If
Next i
End If
End If
Next r
If son = 1 Then
sat1 = sat1 + 10
End If
Next J
MsgBox "işlem tamam"
End Sub
 
Halit Bey Teşekkür ederim ellerinize sağlık. Yalnız bir kaç sorum olacak. Dosyamı ekledim bakabilirseniz sevinirim.
 

Ekli dosyalar

rhombeus' Alıntı:
Halit Bey Teşekkür ederim ellerinize sağlık. Yalnız bir kaç sorum olacak. Dosyamı ekledim bakabilirseniz sevinirim.
Genişletmek için tıkla ...

buı kodu denermisiniz.

Kod: 
Sub aktar()
Sheets("RAPOR").Rows("2:1000").ClearContents
sat1 = 2
For J = 3 To 28
aranan1 = Sheets("GENEL HAFTALIK").Cells(J, "C").Value
son = 0
For r = 3 To 28
If Sheets("RAPOR").Cells(1, "A").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("GENEL HAFTALIK").Range("C2:C" & r), aranan1) = 1 Then
For i = r To 28
sat = 2
aranan2 = Sheets("GENEL HAFTALIK").Cells(i, 3).Value
If aranan2 = aranan1 Then
Sheets("RAPOR").Cells(sat1, 1).Value = aranan1
Sheets("RAPOR").Cells(sat1 + 1, 1).Value = "SATIŞ"
Sheets("RAPOR").Cells(sat1 + 2, 1).Value = "CH"
Sheets("RAPOR").Cells(sat1 + 3, 1).Value = "FİRMA ÇEKİ"
Sheets("RAPOR").Cells(sat1 + 4, 1).Value = "MÜŞTERİ ÇEKİ"
Sheets("RAPOR").Cells(sat1 + 5, 1).Value = "RİSK LİMİTİ"
Sheets("RAPOR").Cells(sat1 + 6, 1).Value = "TEMİNAT"
Sheets("RAPOR").Cells(sat1 + 7, 1).Value = "RİSK"
For n = 5 To Worksheets("GENEL HAFTALIK").Cells(2, 255).End(xlToLeft).Column
Sheets("RAPOR").Cells(sat1, sat).Value = Sheets("GENEL HAFTALIK").Cells(1, n).Value
Sheets("RAPOR").Cells(sat1 + 1, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 1, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n).Value)
Sheets("RAPOR").Cells(sat1 + 2, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 2, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 1).Value)
Sheets("RAPOR").Cells(sat1 + 3, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 3, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 2).Value)
Sheets("RAPOR").Cells(sat1 + 4, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 4, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 3).Value)
Sheets("RAPOR").Cells(sat1 + 5, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 5, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 4).Value)
Sheets("RAPOR").Cells(sat1 + 6, sat).Value = CDbl(Sheets("RAPOR").Cells(sat1 + 6, sat).Value) + CDbl(Sheets("GENEL HAFTALIK").Cells(i, n + 5).Value)
Sheets("RAPOR").Cells(sat1 + 7, sat).Value = "=(-R[-2]C-R[-1]C)+R[-5]C*R5C46+R[-4]C*R6C46+R[-3]C*R7C46"
sat = sat + 1
n = n + 5
son = 1
Next n
End If
Next i
End If
End If
Next r
If son = 1 Then
sat1 = sat1 + 10
End If
Next J
MsgBox "İşleminiz Tamamlanmıştır", vbInformation, "BİLGİ"
End Sub
 
Halit bey teşekkür ederim ilginizden dolayı. Sadece tek bir problem var. Oda AT 5, 6, 7 hücrelerindeki veriler tuşa basıldığında otomatik olarak siliniyor. Nasıl düzeltebiliriz?
 
rhombeus' Alıntı:
Halit bey teşekkür ederim ilginizden dolayı. Sadece tek bir problem var. Oda AT 5, 6, 7 hücrelerindeki veriler tuşa basıldığında otomatik olarak siliniyor. Nasıl düzeltebiliriz?
Genişletmek için tıkla ...

o hücrelerdeki değerleri 1 satıra hepsini almak gerekiyor
örnek AR1,AS1,AT1 hücreleri bu 1. satır silinmiyor

diğer türlü aşağıdaki kodun yerine

Kod: 
Sheets("RAPOR").Rows("2:1000").ClearContents

bunu yaz

Kod: 
Sheets("RAPOR").Range("A2:AO5000").ClearContents
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst