Combobox'dan veri aktarma

[EmrExcel16]

Range yazan yerlerin başina sheets("Liste"). seklinde ekleme yaparak sayfaları belirtebilirsiniz.

 

[seddur]

Denedim başaramadım özellikle - If WorksheetFunction.CountIf(Range("d2:d" & i), Range("d" & i).Value) = 1 Then - kodunda countif den sonra yazan yere uygulayınca hata veriyor.Kodun tümünü yapıştırıyorum.İlgilenirseniz sevinirim.

Dim i As Long
ComboBox1.Clear
Sheets("Sayfa1").Range("A2:Z1000").ClearContents
x = 1
For i = 2 To Range("c65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("d2:d" & i), Range("d" & i).Value) = 1 Then
ComboBox1.AddItem Cells(i, "d").Value

If Sheets("Sayfa1").Cells(Rows.Count, x).End(3).Row + 1 > 15 Then x = x + 1
Sheets("Sayfa1").Cells(Sheets("Sayfa1").Cells(Rows.Count, x).End(3).Row + 1, x) = Cells(i, "d").Value

End If
Next i

 

[Mdemir63]

If WorksheetFunction.CountIf(Worksheets("Liste").Range("c2:c" & i), Worksheets("Liste").Range("c" & i).Value) = 1 Then

olarak değiştirin

 

[seddur]

Dim i As Long

Sheets("Sayfa1").Range("A2:Z1000").ClearContents
x = 1
For i = 2 To Range("c65536").End(xlUp).Row
If WorksheetFunction.CountIf(Worksheets("Liste")(Range("d2:d" & i), Worksheets("Liste").Range("d" & i).Value)) = 1 Then
ComboBox1.AddItem Cells(i, "d").Value

If Sheets("Sayfa1").Cells(Rows.Count, x).End(3).Row + 1 > 15 Then x = x + 1
Sheets("Sayfa1").Cells(Sheets("Sayfa1").Cells(Rows.Count, x).End(3).Row + 1, x) = Cells(i, "d").Value

End If
Next i

Hocam ...Selamlar.Bu kod çektiği verileri Sayfa 1 e aktarıyor.Acaba kodu bulunduğu sayfaya aktaracak şekilde düzenleyebilirmiyiz.Eğer müsaitseniz.

 

[seddur]

.

 

[seddur]

.

 

[seddur]

.

 

[seddur]

.

 

[seddur]

..

 

[seddur]

.