Benzersiz kayıtları sayfalara aktarma

[Bakigemlik]

Merhaba,

Ek dosyada "E" sütunundaki benzersiz kayıtları A sütunundaki sayfa adına göre sayfalara dağıtılması için kod desteğinizi rica ederim,

Bu dosya günlük olarak doldurulan bir dosya veriler hergün giriliyor eğer yinelenen değer varsa onları aktarmaması tekrar etmeyen verileri aktarması gerekiyor aktarılacak hücreler B ile Ab arasındakiler,

Şimdiden çok teşekkürler, saygılarımla,

 

[Murat OSMA]

Merhaba Baki Bey,

Module içerisine bu kodları;

[FONT="Trebuchet MS"][SIZE="2"]Option Compare Text
Sub Emre()
    Dim i&, a As Byte
    For i = 2 To Range("A65536").End(3).Row
        For a = 2 To 4
            If Cells(i, 1).Value = Sheets(a).Name Then
                Range("A" & i & ":AB" & i).Copy Sheets(a).Range("A65536").End(3)(2, 1)
            End If
        Next a
    Next i
    a = Empty: i = Empty
End Sub[/SIZE][/FONT]

ThisWorkbook (BuÇalışmakitabı) içerisine de bu kodları yapıştırın.

[FONT="Trebuchet MS"][SIZE="2"]Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim i&
    Application.ScreenUpdating = False
    With Sh
        If .Name <> "Ana Dosya" Then
            For i = .Range("A65536").End(3).Row To 2 Step -1
                If WorksheetFunction.CountIf(.Range("E2:E" & i), .Cells(i, 5)) > 1 Then
                    .Rows(i).Delete
                End If
            Next i
        End If
    End With
    i = Empty
    Application.ScreenUpdating = False
End Sub[/SIZE][/FONT]

 

[Bakigemlik]

çok teşşekkürler, murat bey

 

[Murat OSMA]

Rica ederim Baki Bey, iyi günler.​