Altı adet listBox' u Tek ListBox' Aktarmak

[ynmcan]

Merhaba arkadaşlar;

Userform üzerindeki altı adet ListBox'a aynı sayfanın ayrı ayrı hücre aralıklarından veri almaktayım.

Yapmak istediğim; Bu ListBox'taki verileri, ayrı bir listBox'a alt alta aktarmak.

Bu konuda yardımcı olursanız sevinirim.

Gerekli açıklama ekteki örnek dosyamda.

 

[ynmcan]

Merhaba arkadaşlar;

Userform üzerindeki altı adet ListBox'a aynı sayfanın ayrı ayrı hücre aralıklarından veri almaktayım.

Yapmak istediğim; Bu ListBox'taki verileri, ayrı bir listBox'a alt alta aktarmak.

Bu konuda yardımcı olursanız sevinirim.

Gerekli açıklama ekteki örnek dosyamda

 

[ynmcan]

Sorunun bir kısmını aşağıdaki kod ile çözdüm gibi.

UserForm1.ListBox7.Clear

sat1 = Sheets("Sayfa1").Range("A20").End(3).Row - 1
sat2 = Sheets("Sayfa1").Range("G20").End(3).Row - 1
sat3 = Sheets("Sayfa1").Range("M20").End(3).Row - 1
sat4 = Sheets("Sayfa1").Range("A45").End(3).Row - 26
sat5 = Sheets("Sayfa1").Range("G45").End(3).Row - 26
sat6 = Sheets("Sayfa1").Range("M45").End(3).Row - 26

Sheets("Sayfa1").Range("S50:V" & 2) = ListBox1.List
Sheets("Sayfa1").Range("S50:V" & sat1 + 2) = ListBox2.List
Sheets("Sayfa1").Range("S50:V" & sat1 + sat2 + 2) = ListBox3.List
Sheets("Sayfa1").Range("S50:V" & sat1 + sat2 + sat3 + 2) = ListBox4.List
Sheets("Sayfa1").Range("S50:V" & sat1 + sat2 + sat3 + sat4 + 2) = ListBox5.List
Sheets("Sayfa1").Range("S50:V" & sat1 + sat2 + sat3 + sat4 + sat5 + 2) = ListBox6.List

sat = WorksheetFunction.CountA(Sheets("Sayfa1").Range("S2:S500")) + 1
UserForm1.ListBox7.ColumnWidths = "35;35;35;35"
UserForm1.ListBox7.ColumnCount = 4
UserForm1.ListBox7.List = Sheets("Sayfa1").Range("S2:V" & sat).Value

Ancak Küçük bir sorun kaldı; ListBoxların verilerini aktardığım Excel sayfasının "S2:V45" aralığında alta kalan boş satırlarıda "#YOK #YOK #YOK #YOK" hataları veriyor.Bunu nasıl düzeltebilirim.

Ayrıca yukarıda yazdığım kodu sadeleştirme imkanı varmı ?

Örnek dosym ekte.

 

[ynmcan]

Aşağıdaki kodun kırmızı ile belirtiğim satırlarını yeniden düzenledim. Sorun çözüldü.
Bu kodu sadeleştirme imkanı varmı ?
Örnek dosyam ekte.

UserForm1.ListBox7.Clear

sat1 = Sheets("Sayfa1").Range("A20").End(3).Row - 1
sat2 = Sheets("Sayfa1").Range("G20").End(3).Row - 1
sat3 = Sheets("Sayfa1").Range("M20").End(3).Row - 1
sat4 = Sheets("Sayfa1").Range("A45").End(3).Row - 26
sat5 = Sheets("Sayfa1").Range("G45").End(3).Row - 26
sat6 = Sheets("Sayfa1").Range("M45").End(3).Row - 26

[COLOR="Red"]Sheets("Sayfa1").Range("S" & sat1 + 1, "V" & 2) = ListBox1.List
Sheets("Sayfa1").Range("S" & sat1 + sat2 + 1, "V" & sat1 + 2) = ListBox2.List
Sheets("Sayfa1").Range("S" & sat1 + sat2 + sat3 + 1, "V" & sat1 + sat2 + 2) = ListBox3.List
Sheets("Sayfa1").Range("S" & sat1 + sat2 + sat3 + sat4 + 1, "V" & sat1 + sat2 + sat3 + 2) = ListBox4.List
Sheets("Sayfa1").Range("S" & sat1 + sat2 + sat3 + sat4 + sat5 + 1, "V" & sat1 + sat2 + sat3 + sat4 + 2) = ListBox5.List
Sheets("Sayfa1").Range("S" & sat1 + sat2 + sat3 + sat4 + sat5 + sat6 + 1, "V" & sat1 + sat2 + sat3 + sat4 + sat5 + 2) = ListBox6.List[/COLOR]

sat = WorksheetFunction.CountA(Sheets("Sayfa1").Range("S2:S500")) + 1
UserForm1.ListBox7.ColumnWidths = "35;35;35;35"
UserForm1.ListBox7.ColumnCount = 4
UserForm1.ListBox7.List = Sheets("Sayfa1").Range("S2:V" & sat).Value

 

[halit3]

Olup olmuyacağını tam bilmiyorum ama bunu bir denermisiniz.

Private Sub CommandButton2_Click()
UserForm1.ListBox7.Clear
Dim sat(7)
sat(1) = 0
sat(2) = Sheets("Sayfa1").Range("A20").End(3).Row - 1
sat(3) = Sheets("Sayfa1").Range("G20").End(3).Row - 1
sat(4) = Sheets("Sayfa1").Range("M20").End(3).Row - 1
sat(5) = Sheets("Sayfa1").Range("A45").End(3).Row - 26
sat(6) = Sheets("Sayfa1").Range("G45").End(3).Row - 26
sat(7) = Sheets("Sayfa1").Range("M45").End(3).Row - 26
yer = 0
yer1 = 0
For i = 2 To 7
yer = yer + sat(i)
yer1 = yer1 + sat(i - 1)
Sheets("Sayfa1").Range("S" & yer + 1, "V" & yer1 + 2) = Controls("ListBox" & i - 1).List
Next
sat8 = WorksheetFunction.CountA(Sheets("Sayfa1").Range("S2:S500")) + 1
UserForm1.ListBox7.ColumnWidths = "35;35;35;35"
UserForm1.ListBox7.ColumnCount = 4
UserForm1.ListBox7.List = Sheets("Sayfa1").Range("S2:V" & sat8).Value
End Sub

 

[halit3]

5 nolu mesajda kod

 

[halit3]

kod 5 nolu mesajda

 

[ynmcan]

Olup olmuyacağını tam bilmiyorum ama bunu bir denermisiniz.

Yazdığınız kodu denedim olmadı. Üzerinde düzenlemeler yapmaya çalışıyorum, bir sonuca varırsam forma eklerim.
İlginize teşekkür ederim.

 

[ynmcan]

kod 5 nolu mesajda

Syn. Halit bey ;
Kusura bakmayın, kod ta düzenleme yaptığınızı sonradan gördüm.
Yeni kodu denedim sorunsuz çalışıyor.
Emeğinize sağlık, teşekkür ederim.