• DİKKAT

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

Sayfalar Arasında Koşula göre Satır Taşımak

A

AdReNaLiYn

Katılım
8 Aralık 2006
Mesajlar
21
Excel Vers. ve Dili
OFFİCE 2003
Öncelikle herkese merhaba. Hazırlamak istediğim form aslında basit ancak kod bilmeyince zor.

Sayfa 1 de bulunan satırlarda çeşitli veriler olduğunu varsayalım. Ben her satırın yanına bir buton veya tamamlandı vb. veya ayarlanabilen bir komut yerine geçecek bir alan olacak. ben o alana yukarıdakilerden birini yazdığımda bu satırı 1. sayfadan silip 2 sayfadaki genel listeye ekleyecek. Bu işlem 1. sayfada her satırda karışık olarak yapıldıkça 2. sayfaya alt alta satırlara bu verileri aktarmak istiyorum. Örnek tablo ektedir. Yardımcı olan arkadaşlara şimdide çok teşekkür ederim. Allah Razı olsun...
 

Ekli dosyalar

Eğer isteğiniz, 1 ila 18 satılar arasındaki aktarım ise, ve P sütununda sadece "TAMİR YAPILDI" yazanları aktaran makroyu yazdım sizin için.. elinizdeki tablodan anladığım kadar ile bu şekilde olması lazım.. Kodunuz ektedir.. Modüle ekleyin ve makroyu bir butona atayın... saygılar..

Kod: 
Sub aktar()  'coded by cihangir..
On Error Resume Next

Set s1 = Sheets("Günlük rapor")
Set s2 = Sheets("DIŞ TAMİR GENEL")

sat = s2.[A65536].End(3).Row + 1

Application.ScreenUpdating = False
For i = 2 To 18

    If s1.Cells(i, "P").Value = "TAMİR YAPILDI" Then
    
        s2.Cells(sat, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(sat, 2).Value = s1.Cells(i, 2).Value
        s2.Cells(sat, 3).Value = s1.Cells(i, 3).Value
        s2.Cells(sat, 4).Value = s1.Cells(i, 4).Value
        s2.Cells(sat, 5).Value = s1.Cells(i, 5).Value
        s2.Cells(sat, 6).Value = s1.Cells(i, 6).Value
        s2.Cells(sat, 7).Value = s1.Cells(i, 7).Value
        s2.Cells(sat, 8).Value = s1.Cells(i, 8).Value
        s2.Cells(sat, 9).Value = s1.Cells(i, 9).Value
        s2.Cells(sat, 10).Value = s1.Cells(i, 10).Value
        s2.Cells(sat, 11).Value = s1.Cells(i, 11).Value
        s2.Cells(sat, 12).Value = s1.Cells(i, 12).Value
        s2.Cells(sat, 13).Value = s1.Cells(i, 13).Value
        s2.Cells(sat, 14).Value = s1.Cells(i, 14).Value
        s2.Cells(sat, 15).Value = s1.Cells(i, 15).Value
        s2.Cells(sat, 16).Value = s1.Cells(i, 16).Value
            sat = sat + 1
     End If
    Next

MsgBox " Aktarım tamamlanmıştır.. ", , ""
Application.ScreenUpdating = True

End Sub
 
Sayın Cihangir Can öncelikle yardımların için çok teşekkür ediyorum. Dün gece forumda baya bir gezindim hızır gibi herkesin yardımına koşuyorsun allah razı olsun.

Yazdığın makro çok iyi tam istediğim şey ancak küçük birkaç değişiklik yapmak gerekiyor. Şimdi örnek verdiğim formda A1-A18 (bu günlük bir liste olduğu için değişebilir) birgün 18 satır tamir varsa ertesi gün 40 tanede olabilir.

Şimdi dikkate alacağımız yerler

*Ekteki örnekte gösterildiği gibi iç tamir olanları tamir tamamlandıktan sonra iç tamir genel sayfasına aktaracak.

*Dış tamir olanları ise tamir tamamlandıktan sonra dış tamir sayfasına aktaracak. (mümkünse ilk sayfadan silecek)

* bizim tam anlamıyla yapmak istediğimiz ise günlük tamir listesi tutmak ancak tamamlanan partileride istediğimiz zaman görebilmek. Bu nedenle tamir olanlar günlük listeden düşsün ancak arka sayfadaki satırlarda kayıtlı olsun.

İlgin için tekrar çok teşekkür ederim. Beni büyük bir dertten kurtardın.
 

Ekli dosyalar

cümlemizden Allah razi olsun,

Öncelikle satır sayısının 18 olmama olayini hallettim.. göndermiş olduğun en son örnekte "H" sütununu baz alarak "DIŞ TAMİR" olanları "DIŞ TAMİR GENEL" sayfasına, "İÇ TAMİR" olanları "İÇ TAMİR GENEL" sayfasına atan makroyu altta yazdım..

*Dış tamir olanları ise tamir tamamlandıktan sonra dış tamir sayfasına aktaracak. (mümkünse ilk sayfadan silecek)
Genişletmek için tıkla ...

bunuda yapmamız mümkündür..

Lakin, KESİNLEŞEMİŞ OLANLAR için "İÇ TAMİR" demişsin.. bunu benim makro ile "İÇ TAMİR GENEL" sayfasına atıyor.. KESİNLEŞMEMİŞ olanları ayrı bir sayfada istiyorsan yeni bir sheet açıp oraya aktarmamız mümkündür.. şu an mevcut durumda "İÇ TAMİR" yazıdığı için "İÇ TAMİR GENEL" sayfasına atacaktır.. nasıl birşey istiyorsan ona göre belirtirsin, kodları ona göre düzenleriz..

Modüldeki kodu bu şekilde değiştirin şimdilik ve inceleyin.. isteğiniz ne ise belirtirsiniz.. saygılar..


Kod: 
Sub aktar()  'coded by cihangir..
On Error Resume Next

Set s1 = Sheets("Günlük rapor")
Set s2 = Sheets("DIŞ TAMİR GENEL")
Set s3 = Sheets("İÇ TAMİR GENEL")

sat = s2.[A65536].End(3).Row + 1
sat1 = s3.[A65536].End(3).Row + 1

Application.ScreenUpdating = False
For i = 2 To s1.[H65536].End(3).Row

    If s1.Cells(i, "H").Value = "DIŞ TAMİR" Then
    
        s2.Cells(sat, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(sat, 2).Value = s1.Cells(i, 2).Value
        s2.Cells(sat, 3).Value = s1.Cells(i, 3).Value
        s2.Cells(sat, 4).Value = s1.Cells(i, 4).Value
        s2.Cells(sat, 5).Value = s1.Cells(i, 5).Value
        s2.Cells(sat, 6).Value = s1.Cells(i, 6).Value
        s2.Cells(sat, 7).Value = s1.Cells(i, 7).Value
        s2.Cells(sat, 8).Value = s1.Cells(i, 8).Value
        s2.Cells(sat, 9).Value = s1.Cells(i, 9).Value
        s2.Cells(sat, 10).Value = s1.Cells(i, 10).Value
        s2.Cells(sat, 11).Value = s1.Cells(i, 11).Value
        s2.Cells(sat, 12).Value = s1.Cells(i, 12).Value
        s2.Cells(sat, 13).Value = s1.Cells(i, 13).Value
        s2.Cells(sat, 14).Value = s1.Cells(i, 14).Value
        s2.Cells(sat, 15).Value = s1.Cells(i, 15).Value
            sat = sat + 1
     End If
    Next i
    
    For y = 2 To s1.[H65536].End(3).Row

    If s1.Cells(y, "H").Value = "İÇ TAMİR" Then
    
        s3.Cells(sat1, 1).Value = s1.Cells(y, 1).Value
        s3.Cells(sat1, 2).Value = s1.Cells(y, 2).Value
        s3.Cells(sat1, 3).Value = s1.Cells(y, 3).Value
        s3.Cells(sat1, 4).Value = s1.Cells(y, 4).Value
        s3.Cells(sat1, 5).Value = s1.Cells(y, 5).Value
        s3.Cells(sat1, 6).Value = s1.Cells(y, 6).Value
        s3.Cells(sat1, 7).Value = s1.Cells(y, 7).Value
        s3.Cells(sat1, 8).Value = s1.Cells(y, 8).Value
        s3.Cells(sat1, 9).Value = s1.Cells(y, 9).Value
        s3.Cells(sat1, 10).Value = s1.Cells(y, 10).Value
        s3.Cells(sat1, 11).Value = s1.Cells(y, 11).Value
        s3.Cells(sat1, 12).Value = s1.Cells(y, 12).Value
        s3.Cells(sat1, 13).Value = s1.Cells(y, 13).Value
        s3.Cells(sat1, 14).Value = s1.Cells(y, 14).Value
        s3.Cells(sat1, 15).Value = s1.Cells(y, 15).Value
            sat1 = sat1 + 1
     End If
    Next y


    

MsgBox " Aktarım tamamlanmıştır.. ", , ""
Application.ScreenUpdating = True

End Sub
 
Tamam ancak bu sefer sadece H sütununu baz alarak hepsini iç tamir veya dış tamir sayfasına atıyor. Bir satırdaki veriyi iç veya dış tamir genel sayfalarına aktarmak için P sütununa tamir yapıldı veya tamir edildi vb. gibi bişey yazmamız şart ki sadece tamir edilenleri atması lazım hepsini değil.

Kesinleşmemiş kısmına gelince ordakiler iç veya dış tamir olabilir. Orda da P sütununa tamir edildi vb. yazarsak H sütunnda iç tamir yazıyorsa iç tamir DIŞ tamir yazıyorsa dış tamir atması gerekiyor. Bunlardan sonra bir eksiğimiz kalmıyor gibi görünüyor. İlgin için tekrar çok teşekkür ederim.

Ve son olarak da iç tamir veya dış tamir yazan yerden genel sayfasına taşınan satırlar ilk sayfadan silinrse çok iyi olur. Gerekirse ilk sayfada yerleri boş kalsın. onu manuel düzeltebiliriz. ancak tamir olanları ilk sayfadan silip ilgili sayfaya atabilirsek süperr olacak.
 
Sayın Cihangir Can yardımcı olabilirsen çok sevinirim. Yok eğer bunlar olmuyor ise ona göre başka çözümler arayacağım.
 
Kod: 
Sub aktar()  'coded by cihangir..
On Error Resume Next

Set s1 = Sheets("Günlük rapor")
Set s2 = Sheets("DIŞ TAMİR GENEL")
Set s3 = Sheets("İÇ TAMİR GENEL")

sat = s2.[A65536].End(3).Row + 1
sat1 = s3.[A65536].End(3).Row + 1

Application.ScreenUpdating = False
For i = 2 To s1.[H65536].End(3).Row

    If s1.Cells(i, "H").Value = "DIŞ TAMİR" _
        And s1.Cells(i, "P").Value = "TAMİR EDİLDİ" Then
    
        s2.Cells(sat, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(sat, 2).Value = s1.Cells(i, 2).Value
        s2.Cells(sat, 3).Value = s1.Cells(i, 3).Value
        s2.Cells(sat, 4).Value = s1.Cells(i, 4).Value
        s2.Cells(sat, 5).Value = s1.Cells(i, 5).Value
        s2.Cells(sat, 6).Value = s1.Cells(i, 6).Value
        s2.Cells(sat, 7).Value = s1.Cells(i, 7).Value
        s2.Cells(sat, 8).Value = s1.Cells(i, 8).Value
        s2.Cells(sat, 9).Value = s1.Cells(i, 9).Value
        s2.Cells(sat, 10).Value = s1.Cells(i, 10).Value
        s2.Cells(sat, 11).Value = s1.Cells(i, 11).Value
        s2.Cells(sat, 12).Value = s1.Cells(i, 12).Value
        s2.Cells(sat, 13).Value = s1.Cells(i, 13).Value
        s2.Cells(sat, 14).Value = s1.Cells(i, 14).Value
        s2.Cells(sat, 15).Value = s1.Cells(i, 15).Value
        s2.Cells(sat, 16).Value = s1.Cells(i, 16).Value

            sat = sat + 1
        
        s1.Cells(i, 1).Delete Shift:=xlUp
        s1.Cells(i, 2).Delete Shift:=xlUp
        s1.Cells(i, 3).Delete Shift:=xlUp
        s1.Cells(i, 4).Delete Shift:=xlUp
        s1.Cells(i, 5).Delete Shift:=xlUp
        s1.Cells(i, 6).Delete Shift:=xlUp
        s1.Cells(i, 7).Delete Shift:=xlUp
        s1.Cells(i, 8).Delete Shift:=xlUp
        s1.Cells(i, 9).Delete Shift:=xlUp
        s1.Cells(i, 10).Delete Shift:=xlUp
        s1.Cells(i, 11).Delete Shift:=xlUp
        s1.Cells(i, 12).Delete Shift:=xlUp
        s1.Cells(i, 13).Delete Shift:=xlUp
        s1.Cells(i, 14).Delete Shift:=xlUp
        s1.Cells(i, 15).Delete Shift:=xlUp
        s1.Cells(i, 16).Delete Shift:=xlUp

     End If
    Next i
    
    For y = 2 To s1.[H65536].End(3).Row

    If s1.Cells(y, "H").Value = "İÇ TAMİR" And _
        s1.Cells(y, "P").Value = "TAMİR EDİLDİ" Then
    
        s3.Cells(sat1, 1).Value = s1.Cells(y, 1).Value
        s3.Cells(sat1, 2).Value = s1.Cells(y, 2).Value
        s3.Cells(sat1, 3).Value = s1.Cells(y, 3).Value
        s3.Cells(sat1, 4).Value = s1.Cells(y, 4).Value
        s3.Cells(sat1, 5).Value = s1.Cells(y, 5).Value
        s3.Cells(sat1, 6).Value = s1.Cells(y, 6).Value
        s3.Cells(sat1, 7).Value = s1.Cells(y, 7).Value
        s3.Cells(sat1, 8).Value = s1.Cells(y, 8).Value
        s3.Cells(sat1, 9).Value = s1.Cells(y, 9).Value
        s3.Cells(sat1, 10).Value = s1.Cells(y, 10).Value
        s3.Cells(sat1, 11).Value = s1.Cells(y, 11).Value
        s3.Cells(sat1, 12).Value = s1.Cells(y, 12).Value
        s3.Cells(sat1, 13).Value = s1.Cells(y, 13).Value
        s3.Cells(sat1, 14).Value = s1.Cells(y, 14).Value
        s3.Cells(sat1, 15).Value = s1.Cells(y, 15).Value
        s3.Cells(sat1, 16).Value = s1.Cells(y, 16).Value

            sat1 = sat1 + 1
            
        s1.Cells(y, 1).Delete Shift:=xlUp
        s1.Cells(y, 2).Delete Shift:=xlUp
        s1.Cells(y, 3).Delete Shift:=xlUp
        s1.Cells(y, 4).Delete Shift:=xlUp
        s1.Cells(y, 5).Delete Shift:=xlUp
        s1.Cells(y, 6).Delete Shift:=xlUp
        s1.Cells(y, 7).Delete Shift:=xlUp
        s1.Cells(y, 8).Delete Shift:=xlUp
        s1.Cells(y, 9).Delete Shift:=xlUp
        s1.Cells(y, 10).Delete Shift:=xlUp
        s1.Cells(y, 11).Delete Shift:=xlUp
        s1.Cells(y, 12).Delete Shift:=xlUp
        s1.Cells(y, 13).Delete Shift:=xlUp
        s1.Cells(y, 14).Delete Shift:=xlUp
        s1.Cells(y, 15).Delete Shift:=xlUp
        s1.Cells(y, 16).Delete Shift:=xlUp
                       
     End If
    Next y


    

MsgBox " Aktarım tamamlanmıştır.. ", , ""
Application.ScreenUpdating = True

End Sub

p sütununa "TAMİR EDİLDİ", "TAMİR EDİLMEDİ" ve "KESİNLEŞMEDİ" gibi belirtmeniz gerekiyor.. kodlar bu koşula göre çalışıyor.. "TAMİR EDİLDİ" olanları ilgili sayfalara aktarıyor, "TAMİR EDİLMEDİ ve KESİNLEŞMEDİ" gibi uyarısı olanlarıda ana sayfada bırakıyor..



ayrıca bu yukarıdaki koda göre satırı silme işlemini yapabiliyoruz
fakat bir sorunumuz var..

22.satırdan sonraki analiz tablonuzu başka sayfaya almanız gerekecek, satır silme işlemi gerçekleşirken alttaki bu analiz tablonuz bozuluyor..

he bana derseniz, satır silme olmasın aktarılan verilerin yerleri boş kalsın diyorsanız, hücre içini boşaltma makrosu yazacagim size... siz buna bir bakın değerlendirin.. tekrar dönüş yaparsınız..
 
Son düzenleme:
:) Bugün aldığım en güzel haber bu. Bende bu akşam bi kontrol edeyim muhtemelen bu şekliyle sorunsuz kullanacağım. İlgin ve alakan için tekrar teşekkür ederim. Benimde yardımcı olabileceğim zamanı bekliyorum :)
 
Satır silme işlemi olmazsa çok iyi olacak taşıdığı hücreleri boş bıraksın ancak satırları silmesin. biz manuel düzenleme yaparız. Teşekkürler.
 
Silinen satır yerine en son dolu satırdan sonra otomatik satır ekleme makrosu yazılırsa analiz tablosu da bozulmamış olur diye düşünüyorum. İnşallah düşüncem yanlış değildir. Yanlış ise özür dilerim. İyi çalışmalar
 
Dosyanız ektedir, İnceleyiniz..

Kod: 
Sub aktar()  'coded by cihangir..
On Error Resume Next

Set s1 = Sheets("Günlük rapor")
Set s2 = Sheets("DIŞ TAMİR GENEL")
Set s3 = Sheets("İÇ TAMİR GENEL")

sat = s2.[A65536].End(3).Row + 1
sat1 = s3.[A65536].End(3).Row + 1

Application.ScreenUpdating = False
For i = 2 To s1.[H65536].End(3).Row

    If s1.Cells(i, "H").Value = "DIŞ TAMİR" _
        And s1.Cells(i, "P").Value = "TAMİR EDİLDİ" Then
    
        s2.Cells(sat, 1).Value = s1.Cells(i, 1).Value
        s2.Cells(sat, 2).Value = s1.Cells(i, 2).Value
        s2.Cells(sat, 3).Value = s1.Cells(i, 3).Value
        s2.Cells(sat, 4).Value = s1.Cells(i, 4).Value
        s2.Cells(sat, 5).Value = s1.Cells(i, 5).Value
        s2.Cells(sat, 6).Value = s1.Cells(i, 6).Value
        s2.Cells(sat, 7).Value = s1.Cells(i, 7).Value
        s2.Cells(sat, 8).Value = s1.Cells(i, 8).Value
        s2.Cells(sat, 9).Value = s1.Cells(i, 9).Value
        s2.Cells(sat, 10).Value = s1.Cells(i, 10).Value
        s2.Cells(sat, 11).Value = s1.Cells(i, 11).Value
        s2.Cells(sat, 12).Value = s1.Cells(i, 12).Value
        s2.Cells(sat, 13).Value = s1.Cells(i, 13).Value
        s2.Cells(sat, 14).Value = s1.Cells(i, 14).Value
        s2.Cells(sat, 15).Value = s1.Cells(i, 15).Value
        s2.Cells(sat, 16).Value = s1.Cells(i, 16).Value

            sat = sat + 1
        
        s1.Cells(i, 1).ClearContents
        s1.Cells(i, 2).ClearContents
        s1.Cells(i, 3).ClearContents
        s1.Cells(i, 4).ClearContents
        s1.Cells(i, 5).ClearContents
        s1.Cells(i, 6).ClearContents
        s1.Cells(i, 7).ClearContents
        s1.Cells(i, 8).ClearContents
        s1.Cells(i, 9).ClearContents
        s1.Cells(i, 10).ClearContents
        s1.Cells(i, 11).ClearContents
        s1.Cells(i, 12).ClearContents
        s1.Cells(i, 13).ClearContents
        s1.Cells(i, 14).ClearContents
        s1.Cells(i, 15).ClearContents
        s1.Cells(i, 16).ClearContents

     End If
    Next i
    
    For y = 2 To s1.[H65536].End(3).Row

    If s1.Cells(y, "H").Value = "İÇ TAMİR" And _
        s1.Cells(y, "P").Value = "TAMİR EDİLDİ" Then
    
        s3.Cells(sat1, 1).Value = s1.Cells(y, 1).Value
        s3.Cells(sat1, 2).Value = s1.Cells(y, 2).Value
        s3.Cells(sat1, 3).Value = s1.Cells(y, 3).Value
        s3.Cells(sat1, 4).Value = s1.Cells(y, 4).Value
        s3.Cells(sat1, 5).Value = s1.Cells(y, 5).Value
        s3.Cells(sat1, 6).Value = s1.Cells(y, 6).Value
        s3.Cells(sat1, 7).Value = s1.Cells(y, 7).Value
        s3.Cells(sat1, 8).Value = s1.Cells(y, 8).Value
        s3.Cells(sat1, 9).Value = s1.Cells(y, 9).Value
        s3.Cells(sat1, 10).Value = s1.Cells(y, 10).Value
        s3.Cells(sat1, 11).Value = s1.Cells(y, 11).Value
        s3.Cells(sat1, 12).Value = s1.Cells(y, 12).Value
        s3.Cells(sat1, 13).Value = s1.Cells(y, 13).Value
        s3.Cells(sat1, 14).Value = s1.Cells(y, 14).Value
        s3.Cells(sat1, 15).Value = s1.Cells(y, 15).Value
        s3.Cells(sat1, 16).Value = s1.Cells(y, 16).Value

            sat1 = sat1 + 1
            
        s1.Cells(y, 1).ClearContents
        s1.Cells(y, 2).ClearContents
        s1.Cells(y, 3).ClearContents
        s1.Cells(y, 4).ClearContents
        s1.Cells(y, 5).ClearContents
        s1.Cells(y, 6).ClearContents
        s1.Cells(y, 7).ClearContents
        s1.Cells(y, 8).ClearContents
        s1.Cells(y, 9).ClearContents
        s1.Cells(y, 10).ClearContents
        s1.Cells(y, 11).ClearContents
        s1.Cells(y, 12).ClearContents
        s1.Cells(y, 13).ClearContents
        s1.Cells(y, 14).ClearContents
        s1.Cells(y, 15).ClearContents
        s1.Cells(y, 16).ClearContents
                       
     End If
    Next y

MsgBox " TAMİR EDİLENLER'in Aktarımı tamamlanmıştır.. ", , ""
Application.ScreenUpdating = True

End Sub
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst