ListBox'a veri aktarma Lütfen Yardım..:(

[bistrobellman]

Personel Dosyasındaki Sayfa1 'de A1 hücresini seçtirip "SÜZ" diyorum.
vardiya1 diye önceden tanımladığım kritere ve PB olanları süzüyor.
çıkan süzme işlemini ;komple CurrentRegion ile boş bir çalışma dosyası eklenerek (WorkBooks.add) alıp kopyalayarak UserForm2 üzerindeki ListBox12 de aynen süzme sonucunun görünmesini istiyorum.BİR TÜRLÜ BAÞARAMADIM...BASİT AMA GÃ?REMEDİM.YARDIM EDİNİZ LÜTFEN ACİL BİRAZ DURUMUM.KODLAR BUYRUN:


Worksheets("PERSONEL").Select: Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=vardiya1
Selection.AutoFilter Field:=5, Criteria1:=" PB"
Range("A1").AutoFilter
Range("A1:F20").Select
Selection.CurrentRegion.Copy

Workbooks.Add.SaveAs Filename:="aaa.xls"
Range("A1").PasteSpecial xlPasteAll

Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
r = ActiveCell.Row

UserForm2.ListBox12.RowSource Sayfa1!A1:"F & r[/b]
Unload UserForm1
UserForm2.Show

 

[idogus]

[vb:1:049827db7b]
Worksheets("PERSONEL").Select: Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:=vardiya1
Selection.AutoFilter Field:=5, Criteria1:=" PB"
Range("A1").AutoFilter
Range("A1:F20").Select
Selection.CurrentRegion.Copy

Workbooks.Add.SaveAs Filename:="aaa.xls"
Range("A1").PasteSpecial xlPasteAll

vr = WorkSheetFunction.CountA(Sheets(ActiveSheet.Name).[A1:A65536])
UserForm2.ListBox12.ColumnCount = 6
For i = 2 To vr
If Sheets(ActiveSheet.Name).Rows(i).Hidden = False Then
UserForm2.ListBox12.RowSource = "Sayfa1!A1:F" & i 'r değiştirildi.
End If
Next i

Unload UserForm1
UserForm2.Show
[/vb:1:049827db7b]

 

[bistrobellman]

idoqus kodlar için sağolda son satırlardaki r ne oluyor? kodlarda r ile ilgili bir tanımlama yok??

 

[idogus]

pardon senin kodlarını kopyaladım r yerine i olacak

 

[bistrobellman]

kodları deneyip çalıştırdınız mı? ben deneyecem bir sorun çıkarsa lütfen bu topiğimi gözden kaçırma. kodları denedikten sonra her türlü durumda mail atacam..sağolasın