• DİKKAT

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

Veriyi süzerek ikinci tabloya taşıma

formülle yapıldığında dosyanız çok fazla kasılır çalışamaz duruma gelirsiniz veri girdikçe
bunun için makro tavsiye ederim
 
İhsan Tank' Alıntı:
eki inceleyiniz
Kasa Sayfasındaki Aktar Butonuna Tıklayın
Kod: 
Option Explicit
Sub masraf_aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Masrafları Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
kaplan = 3
For ts = 4 To Sheets("KASA").Cells(65536, "F").End(xlUp).Row
If Sheets("KASA").Cells(ts, "F") <> "" Or _
Sheets("KASA").Cells(ts, "F") <> "GELİR" Then
Sheets("MASRAF").Cells(kaplan, "A") = Sheets("KASA").Cells(ts, "A")
Sheets("MASRAF").Cells(kaplan, "B") = Sheets("KASA").Cells(ts, "B")
Sheets("MASRAF").Cells(kaplan, "C") = Sheets("KASA").Cells(ts, "E")
Sheets("MASRAF").Cells(kaplan, "D") = Sheets("KASA").Cells(ts, "G")
Sheets("MASRAF").Cells(kaplan, "E") = Sheets("KASA").Cells(ts, "H")
Sheets("MASRAF").Cells(kaplan, "F") = Sheets("KASA").Cells(ts, "I")
Sheets("MASRAF").Cells(kaplan, "G") = Sheets("KASA").Cells(ts, "J")
Sheets("MASRAF").Cells(kaplan, "H") = Sheets("KASA").Cells(ts, "K")
Sheets("MASRAF").Cells(kaplan, "I") = Sheets("KASA").Cells(ts, "L")
Sheets("MASRAF").Cells(kaplan, "J") = Sheets("KASA").Cells(ts, "M")
Sheets("MASRAF").Cells(kaplan, "K") = Sheets("KASA").Cells(ts, "N")
End If
Next
MsgBox "Masrafları Aktardım", vbInformation, "Bitiş"
End Sub
Genişletmek için tıkla ...

Hocam bu kodda çalışmadı :( Taşıyamadım. Başka bir fikriniz varsa teşşekkür ederim.Kolay gelsin.
 
arser83' Alıntı:
Hocam bu kodda çalışmadı :( Taşıyamadım. Başka bir fikriniz varsa teşşekkür ederim.Kolay gelsin.
Genişletmek için tıkla ...

kodda bir eksiklik vardı
Kod: 
Option Explicit
Sub masraf_aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Masrafları Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
kaplan = 3
For ts = 4 To Sheets("KASA").Cells(65536, "F").End(xlUp).Row
If Sheets("KASA").Cells(ts, "F") <> "" And _
Sheets("KASA").Cells(ts, "F") <> "GELİR" Then
Sheets("MASRAF").Cells(kaplan, "A") = Sheets("KASA").Cells(ts, "A")
Sheets("MASRAF").Cells(kaplan, "B") = Sheets("KASA").Cells(ts, "B")
Sheets("MASRAF").Cells(kaplan, "C") = Sheets("KASA").Cells(ts, "E")
Sheets("MASRAF").Cells(kaplan, "D") = Sheets("KASA").Cells(ts, "G")
Sheets("MASRAF").Cells(kaplan, "E") = Sheets("KASA").Cells(ts, "H")
Sheets("MASRAF").Cells(kaplan, "F") = Sheets("KASA").Cells(ts, "I")
Sheets("MASRAF").Cells(kaplan, "G") = Sheets("KASA").Cells(ts, "J")
Sheets("MASRAF").Cells(kaplan, "H") = Sheets("KASA").Cells(ts, "K")
Sheets("MASRAF").Cells(kaplan, "I") = Sheets("KASA").Cells(ts, "L")
Sheets("MASRAF").Cells(kaplan, "J") = Sheets("KASA").Cells(ts, "M")
Sheets("MASRAF").Cells(kaplan, "K") = Sheets("KASA").Cells(ts, "N")
kaplan = kaplan + 1
End If
Next
MsgBox "Masrafları Aktardım", vbInformation, "Bitiş"
End Sub
bunu deneyin
 
hocam, yukarıdaki örnekte 2 seçenek var (KASA ve MASRAF) bunun yerine ne yazmalıyım ki bendeki 10-15 gibi çoklu seçenekte bu program çalışsın.her bir seçenek için kitap açsam ve oralara bu programı yapsam.ana listeden aynı adlardan verileri çeksem bu mümkünmüdür. bana yol gösterirmisiniz.(ana listem giriş listesi, seçenek kitabımda ise verilerin kendi adlarında listelenmesi olacak)
 
unerfahren' Alıntı:
hocam, yukarıdaki örnekte 2 seçenek var (KASA ve MASRAF) bunun yerine ne yazmalıyım ki bendeki 10-15 gibi çoklu seçenekte bu program çalışsın.her bir seçenek için kitap açsam ve oralara bu programı yapsam.ana listeden aynı adlardan verileri çeksem bu mümkünmüdür. bana yol gösterirmisiniz.(ana listem giriş listesi, seçenek kitabımda ise verilerin kendi adlarında listelenmesi olacak)
Genişletmek için tıkla ...

ben sizin dosyanızda böyle bir şey göremedim.
ama tahminen şunu söyleyebilirim
firmalara altta yeni sayfalar açın ve makro yardımı ile istediğiniz bilgileri bu sayfalara toplayın
 
İhsan Tank' Alıntı:
kodda bir eksiklik vardı
Kod: 
Option Explicit
Sub masraf_aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Masrafları Aktarıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
kaplan = 3
For ts = 4 To Sheets("KASA").Cells(65536, "F").End(xlUp).Row
If Sheets("KASA").Cells(ts, "F") <> "" And _
Sheets("KASA").Cells(ts, "F") <> "GELİR" Then
Sheets("MASRAF").Cells(kaplan, "A") = Sheets("KASA").Cells(ts, "A")
Sheets("MASRAF").Cells(kaplan, "B") = Sheets("KASA").Cells(ts, "B")
Sheets("MASRAF").Cells(kaplan, "C") = Sheets("KASA").Cells(ts, "E")
Sheets("MASRAF").Cells(kaplan, "D") = Sheets("KASA").Cells(ts, "G")
Sheets("MASRAF").Cells(kaplan, "E") = Sheets("KASA").Cells(ts, "H")
Sheets("MASRAF").Cells(kaplan, "F") = Sheets("KASA").Cells(ts, "I")
Sheets("MASRAF").Cells(kaplan, "G") = Sheets("KASA").Cells(ts, "J")
Sheets("MASRAF").Cells(kaplan, "H") = Sheets("KASA").Cells(ts, "K")
Sheets("MASRAF").Cells(kaplan, "I") = Sheets("KASA").Cells(ts, "L")
Sheets("MASRAF").Cells(kaplan, "J") = Sheets("KASA").Cells(ts, "M")
Sheets("MASRAF").Cells(kaplan, "K") = Sheets("KASA").Cells(ts, "N")
kaplan = kaplan + 1
End If
Next
MsgBox "Masrafları Aktardım", vbInformation, "Bitiş"
End Sub
bunu deneyin
Genişletmek için tıkla ...

Olacak gibi , bu kodda Sheets("KASA").Cells(ts, "F") <> "GELİR" Then burası GELİR olanları taşıma anlamınamı geliyor ve ikinci soru eğer öyleyse , bunu GELİR - SATIŞ - PAZARLAMA vs. gibi birden fazla olarak çoğaltabilirmiyiz.
 
Hocam çok çok teşekkür ederim. Allah razı olsun , hakkını helal et.. Sorduğum soruyu deneyerek yaptım. İstediğim gibi oldu. Başka bir şey çıkarsa artık gene yazarız. :)

Sheets("KASA").Cells(ts, "F") <> "GELİR" Then bunu çoğalttım.
 
arser83' Alıntı:
Hocam çok çok teşekkür ederim. Allah razı olsun , hakkını helal et.. Sorduğum soruyu deneyerek yaptım. İstediğim gibi oldu. Başka bir şey çıkarsa artık gene yazarız. :)

Sheets("KASA").Cells(ts, "F") <> "GELİR" Then bunu çoğalttım.
Genişletmek için tıkla ...

çoğaltmak sizin elinizde
rica ederim
Allah Hepimizden Razı Olsun
Ne hakkım var ki
Varsa bile Helal Olsun
:yazici:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst