• DİKKAT

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

Verileri süzerek diğer sayfalara aktarmak..

Katılım
13 Ocak 2008
Mesajlar
142
Excel Vers. ve Dili
2003 office
arkadaşlar açıklamayı dosya içinde yaptım kısaca : kodları aynı olanların diğer sayfalara otomatik olarak dağılmasını istiorum yardımlarınız için şimdiden teşekkürler :yardim:

konunun daha önce açılıp açılmadığını bulamadım inşallah açılmamıştır.
 

Ekli dosyalar

2009 geliyo benim bunu ayın 20 sine kadar bulmak istiyorum

sorun şu veriler sayfasındaki isimlerin kodlarına göre sayfalara dağılmasını istiyorum.
 
SN YURTTAŞ

VERMİŞ OLDUĞUNUZ ÖRNEKTEKİ KODU KENDİME GÖRE ŞU ŞEKİLDE ;

Option Explicit

Sub DAGIT()
Dim s1 As Worksheet
Dim sY As Worksheet
Dim ALAN As Range
Dim r As Integer
Dim c As Range
Set s1 = Sheets("Döküm")
Set ALAN = Range("veritabanı")


s1.Columns("T:T").Copy _
Destination:=Range("BC1")
s1.Columns("BC:BC").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("BA1"), Unique:=True
r = Cells(Rows.Count, "BA").End(xlUp).Row


Range("BC1").Value = Range("T1").Value

For Each c In Range("BA2:BA" & r)

s1.Range("BC2").Value = c.Value

If SAYFA(c.Value) Then
Sheets(c.Value).Cells.Clear
ALAN.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Döküm").Range("BC1:BC2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set sY = Sheets.Add
sY.Move After:=Worksheets(Worksheets.Count)
sY.Name = c.Value
ALAN.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Döküm").Range("BC1:BC2"), _
CopyToRange:=sY.Range("A1"), _
Unique:=False
End If
Next
s1.Select
s1.Columns("BA:BC").Delete
End Sub
Function SAYFA(SAYFAADI As String) As Boolean
On Error Resume Next
SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function


YAPTIM VE AKTARDI ANCAK AKTARDIĞI VERİLERİ SAYFADAN SİLMİŞ
ÖRNEK EKTE
 
Dosyanız ektedir, inceleyiniz.
İyi bir bir çalışma emeğinize sağlık, burada bir isteğim olacak, rakamlara göre ilgili dosyalara verileri süzmek yerine adı ve soyadına göre veriler süzülecek bunu yapabilmek mümkünmü. ekte dosyada da belirttim.yardımlarınız için şimdiden teşekkürler.
 

Ekli dosyalar

Aşağıdaki kodu siliniz.:cool:
Kod:
s1.Columns("BA:BC").Delete
 
İstediğiniz dosya ekteki gibimi olacak?

Sn. istanbulcahan, dosyayı incelermisiniz, istediğiniz bu şekildemi.
 

Ekli dosyalar

Sn. istanbulcahan, dosyayı incelermisiniz, istediğiniz bu şekildemi.

Veriler kısmındaki F2 hücresinde yukarıdan aşağıya her isim görev eklemesinin "ekle" tuşunun olması isim ve bilgiler yazıldığında ekle tuşuna basıldığında ilgili kişinin sheetine gitmesi ve ekle tuşu böylece ortadan kalkmalı. her isim ve bilgi eklendiğinde bu işlem uygulanmalı. C1 blümündeki hücrede belirttiğim sarı yerde her görev eklendiğinde yeni tarihler üstte olacak. Yardımların için teşekkürler.
 

Ekli dosyalar

Geri
Üst