Combobox la listboxta Filtre ve sayfalara dağılım

[taseraydin]

Değerli üstad arkadaşlar
Ekli örnek dosyamda A ve B Statüsünde personeli listboxta filtreleme ve statülere göre (A ve B) sayfalara dağılımın yapılmasında yardımlarınızı rica ediyorum

 

[N.Ziya Hiçdurmaz]

yanıt

Private Sub ComboBox1_Change()
Sayfa3.[A4:N5000].Clear
With Sayfa1
.AutoFilterMode = False
.Range("d2").AutoFilter field:=4, Criteria1:=ComboBox1
.[A4].CurrentRegion.Copy Sayfa3.[A4]
End With
End Sub
Private Sub CommandButton1_Click()
Dim sat, s, ss As Integer
Sayfa5.[a4:z5000].Clear
Sayfa2.[a4:z5000].Clear
s = 4
ss = 4
With Sayfa1
For sat = 4 To .Cells(65536, "a").End(xlUp).Row
    If .Cells(sat, "d") = "A" Then
    Range(.Cells(sat, "a"), .Cells(sat, "z")).Copy Range(Sayfa5.Cells(s, "a"), Sayfa5.Cells(s, "z"))
    s = s + 1
    End If
    If .Cells(sat, "d") = "B" Then
    Range(.Cells(sat, "a"), .Cells(sat, "z")).Copy Range(Sayfa2.Cells(ss, "a"), Sayfa2.Cells(ss, "z"))
    ss = ss + 1
    End If
Next
End With
End Sub
Private Sub UserForm_Initialize()
With ComboBox1
.AddItem "A"
.AddItem "B"
End With
ListBox1.ColumnCount = 25
    ListBox1.ColumnWidths = "20;100;60;20;45;35;25;45;70;60;60;35;35;35;"
    ListBox1.RowSource = "RAPOR!A4:N" & Sheets("RAPOR").Range("A65536").End(xlUp).Row
End Sub

 

[baydeniro]

Teşekkürler.