Giriştekileri diğer sayfalara süzmek

[fhkoksal]

Konu doğru yerde mi bilemiyorum ama giriş sayfasında yazdıklarımı temsilci ve durum kolonlarına göre süzerek o sayfalara aktarmak istiyorum ama nasıl yapıldığını bilemiyorum dosyayı eke ekliyorum yardımcı olabilecek veya öğretebilecek olan var mı acaba ?


Ekli dosyayı görüntüle Bekleyen Fiş Listesi.xlsx

 

[Muhammet Okumuş]

Merhaba,

Sub Süz()
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
If WorksheetFunction.CountIf(Range("D21000"), Sheets(i).Name) = 0 Then GoTo 10
Range("B2:I2").AutoFilter Field:=3, Criteria1:=Sheets(i).Name
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets(i).Range("C3")
Range("B2:I2").AutoFilter
10
Next
Range("B2:I2").AutoFilter Field:=8, Criteria1:="BEKLEMEDE"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("BEKLEMEDE").Range("C3")

Range("B2:I2").AutoFilter Field:=8, Criteria1:="RED"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("RED").Range("C3")
Range("B2:I2").AutoFilter
End Sub

kodlarını deneyiniz.

 

[fhkoksal]

Hocam harikasınız tam manası ile çalışır durumda Allah sizden razı olsun

ancak ; bişey rica edicem . kodlamayi biraz açıklarmısınız öğrenmek babında

 

[Muhammet Okumuş]

Sub Süz()
Application.ScreenUpdating = False ---- İşlem yaparken görülmesin
For i = 2 To Sheets.Count ---- 2 ile Sayfa sayısı kadar döngü yapar
If WorksheetFunction.CountIf(Range("D21000"), Sheets(i).Name) = 0 Then GoTo 10 ---- Sayfa Adı D sütununda yok ise 10 yazan satıra git
Range("B2:I2").AutoFilter Field:=3, Criteria1:=Sheets(i).Name ---- B2:I2 arasınını filitrele. AutoFilter Field:=3 Bu ifade D sütununa filitre uygular, Kiriter ise döngüdeki sayfa adı
son = Cells(Rows.Count, "D").End(3).Row ---- Filitrelemeden sonra son satırı bul.
Range("C3:I" & son).Copy Sheets(i).Range("C3")---- C3:I son satırı kopyala, Döngüdeki sayfanın C3 hücresine yapıştır.
Range("B2:I2").AutoFilter----Filitreyi kaldır
10
Next


Bu kısım ise Beklemede ve Red yazan verileri ilgili sayfalara aktarır.
Range("B2:I2").AutoFilter Field:=8, Criteria1:="BEKLEMEDE"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("BEKLEMEDE").Range("C3")

Range("B2:I2").AutoFilter Field:=8, Criteria1:="RED"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("RED").Range("C3")
Range("B2:I2").AutoFilter
End Sub

Açıklamayı inceleyiniz.

 

[fhkoksal]

Hocam kodları yerlestirdim birde aktar butonu ile onu bağladım aktar işlemi tam manası ile çalışıyor ancak girişten işlemi değişen veya silinen bir satırın değişikliğini nasıl yaptırabiliriz acaba.

Merhaba,


kodlarını deneyiniz.

 

[Muhammet Okumuş]

Sayfa sayınız az ise fonksiyonlarla çözüme gidebiliriz. Değilse;

Sub Süz()
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).Range("C2:M1000")=""
Next
For i = 2 To Sheets.Count
If WorksheetFunction.CountIf(Range("D21000"), Sheets(i).Name) = 0 Then GoTo 10
Range("B2:I2").AutoFilter Field:=3, Criteria1:=Sheets(i).Name
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets(i).Range("C3")
Range("B2:I2").AutoFilter
10
Next
Range("B2:I2").AutoFilter Field:=8, Criteria1:="BEKLEMEDE"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("BEKLEMEDE").Range("C3")

Range("B2:I2").AutoFilter Field:=8, Criteria1:="RED"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("RED").Range("C3")
Range("B2:I2").AutoFilter
End Sub

kodlarını her düzenlemede çalıştırmalısınız.

 

[Muhammet Okumuş]

Sub Süz()
Application.ScreenUpdating = False
For i = 2 To Sheets.Count
Sheets(i).Range("C2:M1000")=""
If WorksheetFunction.CountIf(Range("D21000"), Sheets(i).Name) = 0 Then GoTo 10
Range("B2:I2").AutoFilter Field:=3, Criteria1:=Sheets(i).Name
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets(i).Range("C3")
Range("B2:I2").AutoFilter
10
Next
Range("B2:I2").AutoFilter Field:=8, Criteria1:="BEKLEMEDE"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("BEKLEMEDE").Range("C3")

Range("B2:I2").AutoFilter Field:=8, Criteria1:="RED"
son = Cells(Rows.Count, "D").End(3).Row
Range("C3:I" & son).Copy Sheets("RED").Range("C3")
Range("B2:I2").AutoFilter
End Sub

Bunu kullanın. Tekrar döngüye gerek yok.

 

[fhkoksal]

Hocam en altta veridiğiniz kod kanımca sorunu cözdü. Çok Teşekkür Ederim Tekrardan tam manası ile çalışıyor elinize kolunuza sağlık

Bunu kullanın. Tekrar döngüye gerek yok.