Koşullu benzersiz kopyalam

[gnorar]

Stok sayfasından Genel sayfasına benzersizleri kopyalamak için aşağıdaki kodu kullanıyorum:

If WorksheetFunction.CountIf(Range("A4:A" & j), Cells(j, 1)) = 1 Then
Sheets("Genel").Range("A" & x) = Sheets("Stok").Cells(j, 1).Value
x = x+ 1
End If

Kopyala işleminin Stok sayfası Range("B4:B" & j) hücresinin >0 olması koşuluyla yapılmasını istiyorum. Bu koşullu benzersiz kopyalama işlemi nasıl yapılabilir?

 

[Necdet]

Merhaba,

Sorunuzu örnek bir dosya ile destekleyiniz ve o dosya üzerinde olması gereken durumu belirtiniz.

 

[gnorar]

Örnek bir dosya ekledim.

Burada yapmak istediğim Stok sayfasında tekrar eden aynı illerden bir tanesinin bile stok durumunun pozitif olması durumunda Genel Sayfasına bu ili kopyalamak ve bir daha bu ili kopyalamamak. (Benzersizlerin kopyalanması)
Eklenen dosyada bulunan aşağıdaki 1.Kopyalama makrosu doğal olarak benzersizleri kopyalıyor.
Sub kopya()
Dim x, y As Long
Sheets("Genel").Range("A1:A100") = ""
y = 2
For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A2:A" & x), Cells(x, 1)) = 1 Then
Sheets("Genel").Range("A" & x) = Sheets("Stok").Cells(y, 1).Value
y = y + 1
End If
Next
End Sub

Ancak bu kopyalama işleminin Stok durumun pozitif olması durumunda yapılmasını istiyorum. Bununla ilgili yazdığım eklenen dosyada bulunan aşağıdaki 2. Kopyalama makrosu istediğim gibi çalışmıyor. (İzmir’i Genel sayfasına aktarmıyor)

Sub kopya2()
Dim x, y As Long
Sheets("Genel").Range("A1:A100") = ""
y = 2
For x = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A2:A" & x), Cells(x, 1)) = 1 Then
If Sheets("Stok").Cells(x, 2) > 0 Then
Sheets("Genel").Range("A" & y) = Sheets("Stok").Cells(x, 1).Value
y = y + 1
End If
End If

Bu sorunu nasıl aşarım?