Küçük bir makroyu değiştirmeme yardımcı olurmusunuz?

[stirra_ej]

bu formül sayfa 1 de a1 den olan veriler sayfa 2 de a1 den itibaren benzer verileri teke düşürerek listeliyor
Formülü değiştirmeyi başaramadım
Sayfa 1 g3 den g 500 e kadar olan verilerin benzersizlerini sayfa 2 de c 6 dan itibaren yazdırmaya başlasın
Yardımlarınız için şimdiden teşekkür ederim.

Formül Altta

For a = 1 To [a65536].End(3).Row
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, 1)) = 1 Then
c = c + 1
Sheets("sayfa2").Cells(c, 1) = Cells(a, 1)
End If
Next
End Sub

 

[stirra_ej]

Yardım edebilecek biri yok mu?

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyin

Sub kayıt()
Dim c As Long, a As Long
c = 5
Sheets("sayfa2").Range("C6:C" & 503) = ""
For a = 3 To 500
If WorksheetFunction.CountIf(Range("G3:G" & a), Cells(a, "G")) = 1 Then
c = c + 1
Sheets("sayfa2").Cells(c, "C") = Cells(a, "G")
End If
Next
End Sub

 

[stirra_ej]

Teşekkür ederim eve geçtiğimde deneyeceğim..

 

[stirra_ej]

hocam şurda bir sıkıntı var gibi bu formülü sayfa 2 yani bende ismi Sevkiyat olan sayfanın worksheet activite sine yapıştırdığımda
Sayfa 1 den alması gereken aralık g3:g aralığını da sayfa 2 den almaya çalışıyor o yüzden
Dim c As Long, a As Long

(( f WorksheetFunction.CountIf(Range("G3:G" & a), Cells(a, "G")) = 1 Then )) burda bir değişiklik yapmamız gerekiyor sayfayı giriş olarak eklememiz gerekiyor sanırım

Dim c As Long, a As Long
c = 5
Sheets("Sevkiyat").Range("C6:C" & 60) = ""
For a = 3 To 500
If WorksheetFunction.CountIf(Range("G3:G" & a), Cells(a, "G")) = 1 Then ( buraya sayfa adından sonra hücre aralığı yazdırmalıyız sanırıyorum )
c = c + 1
Sheets("Sevkiyat").Cells(c, "C") = Cells(a, "G")
End If
Next

Yardımcı olabilirmisiniz

 

[PLİNT]

Set s1, s2 tanımlamalarından sayfa adlarını uyarlayın

Sub kayıt()
Dim c As Long, a As Long, s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sevkiyat")
c = 5
s2.Range("C6:C" & 503) = ""
For a = 3 To 500
If WorksheetFunction.CountIf(s1.Range("G3:G" & a), s1.Cells(a, "G")) = 1 Then
c = c + 1
s2.Cells(c, "C") = s1.Cells(a, "G")
End If
Next
End Sub

 

[stirra_ej]

Hemen deniyorum hocam...

 

[stirra_ej]

Mükemmel oldu hocam, çok ama çok teşekkür ederim, saatlerdir uğraşımı saniyeler içinde çözdünüz, iyi günler diliyorum ....

 

[PLİNT]

Rica ederim, kolay gelsin.