[ÇÖZÜLDÜ] Userform'da birden fazla seçenek yazarak sorgulama ve aktarma hk.

[enteresan]

Sevgili excel'ci hocalarım,
Kullanmakta olduğum bir dosyada bazı ürünler var ve bu ürünleri Türkiye'nin ayrı ayrı şehirlerine göndermek için bir plan yapmam gerekiyor. Hazırladığım örnek dosyayı ekte gönderdim. İçersindeki userform'a bütün illerin isimlerini yazdım. Bu iller arasında birkaç tanesini işaretlediğimde, işaretli olan illere ait tüm satırların kopyalanıp, textbox'a yazdığım isimle açılacak sayfaya aktarılmasını istiyorum. Örnek incelendiğinde sorum daha iyi anlaşılacaktır. Yardımlarınızı bekliyorum. Saygı ve sevgilerimle...

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Private Sub CommandButton1_Click()
On Error Resume Next
Dim kontrol1 As Boolean
Dim kontrol2 As Control

Set s1 = Sheets("Sayfa1")
kontrol1 = False
If ComboBox1.Value = "" Then Exit Sub
For i = 1 To Sheets.Count
If Sheets(i).Name = ComboBox1.Value Then
Set s2 = Sheets(i)
kontrol1 = True
End If
Next

If kontrol1 = False Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = ComboBox1.Value
Set s2 = Sheets(ComboBox1.Value)
s2.Range("a1:c1").Value = s1.Range("a1:c1").Value
End If

For Each kontrol2 In Me.Controls
    s = s + 1
    If TypeName(kontrol2) = "CheckBox" Then
        If Controls(s).Value = True Then
            il = Controls(s).Caption
            For Each alan In Sheets("Sayfa1").Range("c2:c100")
                If il = alan Then
                   sat = s2.[a65536].End(3).Row + 1
                   Range(s2.Cells(sat, "a"), s2.Cells(sat, "c")).Value = Range(s1.Cells(alan.Row, "a"), s1.Cells(alan.Row, "c")).Value
                End If
            Next
        End If
    End If
Next kontrol2
s2.Columns("a:a").EntireColumn.AutoFit
s2.Columns("b:b").EntireColumn.AutoFit
s2.Columns("c:c").EntireColumn.AutoFit
Set s1 = Nothing
Set s2 = Nothing
MsgBox "Güzelgah Listesi Oluşturuldu."
End Sub

 

[enteresan]

Sayın ripek,
Bundan iyisi olamazdı sanırım. Size minnettarım. Elinize sağlık....