aktarım

[gedavet]

örnek sayfa1 a1 den aşağı doğru isimler yazacağım sayfa2 ye bu imleri aktaracak yanlız sayfa1 de ismleden çift yazılı olanları bir isim olcak yanı aynı ismi tekrar aktatrmayacak

 

[Orion1]

örnek sayfa1 a1 den aşağı doğru isimler yazacağım sayfa2 ye bu imleri aktaracak yanlız sayfa1 de ismleden çift yazılı olanları bir isim olcak yanı aynı ismi tekrar aktatrmayacak

Sub tekeindir()
Dim hcr As Range, sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
For Each hcr In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("A1:A" & hcr.Row), hcr.Value) = 1 Then
        sat = sat + 1
        Sheets("Sayfa2").Cells(sat, "A").Value = hcr.Value
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub

 

[gedavet]

bu kodu nereye yapıştıracağım

 

[Orion1]

bu kodu nereye yapıştıracağım

VBE'de boş bir standart modüle yapıştırınız.

 

[gedavet]

sayfa2 nin a1 den itibaren aktarılanları yazıyor ben mesela sayfa2 d11 den itibaren yazmasını istiyorum

 

[Orion1]

sayfa2 nin a1 den itibaren aktarılanları yazıyor ben mesela sayfa2 d11 den itibaren yazmasını istiyorum

Tabiki bu tür konuyu kod yazılıp bittikten sonra değil yazılmadan önce belirtmeniz gerkirdi.Ben nerden bilecem 11nci satırdan başlayacağını .varsayılan olarak 1nci satırdan başalyacağını kabul ettim.Buda gayet normaldir.Aşağıdaki kodları kullanınız.

Sub tekeindir()
Dim hcr As Range, sat As Long
Sheets("Sayfa1").Select
[B][COLOR="Red"]sat = 11[/COLOR][/B]
Application.ScreenUpdating = False
For Each hcr In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("A1:A" & hcr.Row), hcr.Value) = 1 Then
        Sheets("Sayfa2").Cells(sat, "A").Value = hcr.Value
        [B][COLOR="red"]sat = sat + 1[/COLOR][/B]
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub

 

[gedavet]

kusura bakbayın olmadı bir sorun var yani ben sayfa1 a1:a25 arasını sayfa2 nin b11:b35 arasına yapmasını istiyorum

 

[Orion1]

kusura bakbayın olmadı bir sorun var yani ben sayfa1 a1:a25 arasını sayfa2 nin b11:b35 arasına yapmasını istiyorum

Aşağıdaki kodu kullanınız.

Sub tekeindir()
Dim hcr As Range, sat As Long
Sheets("Sayfa1").Select
sat = 11
Application.ScreenUpdating = False
Range("B11:B65536").ClearContents
For Each hcr In Range("A1:A" & Cells(65536, "A").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("A1:A" & hcr.Row), hcr.Value) = 1 Then
        Sheets("Sayfa2").Cells(sat, "B").Value = hcr.Value
        sat = sat + 1
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub

 

[gedavet]

örnek çalışma gönderdim buraya uygulayı verebilirmiisniz en son gönderdiğiniz makro olmadı bazı yerleri siliyor

 

[gedavet]

evren bey yardımcı olabilirmisiniz şu işlemi bitirseydik

 

[Orion1]

Dosyanız ekte.

Sub tekeindir()
Dim hcr As Range, sat As Long
Sheets("Sayfa1").Select
sat = 11
Application.ScreenUpdating = False
Sheets("Sayfa2").Range("E11:E65536").ClearContents
For Each hcr In Range("B11:B" & Cells(65536, "B").End(xlUp).Row)
    If WorksheetFunction.CountIf(Range("B1:B" & hcr.Row), hcr.Value) = 1 Then
        Sheets("Sayfa2").Cells(sat, "E").Value = hcr.Value
        sat = sat + 1
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub