• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

alfabetik sıralı iki listedeki aynı kayıtları farklı sayfalara kopyalama

Katılım
17 Kasım 2008
Mesajlar
28
Excel Vers. ve Dili
Excel 2007
Merhabalar, İki ayrı sayfamda alfabetik ve nümerik karakterlerden oluşan firma ünvanları bulunuyor. Ben bunları kendi aralarında alfabetik ve nümerik isimlerden oluşan şekliyle ayırıp farklı sayfalara kopyalamak istiyorum.

Mesala listedeki A ile başlayan kayıtları A isimli sayfaya , B ile başlayan kayıtları B isimli sayfaya 3 veya başka karakterde bulunanları 3 isimli sayfaya aktarılması,

Aşağıya örnek bir dosya ekliyorum.

İlgilenecek arkadaşlara şimdiden teşekkür ediyorum.
 

Ekli dosyalar

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.



Kod:
Sub Sayfa_Olustur_Aktar()
    
    Dim c   As String, _
        ce  As String, _
        i   As Long, _
        j   As Long, _
        ShV As Worksheet
    
    Set ShV = Sheets("veri")
    
    Application.ScreenUpdating = False
    
    For i = 2 To ShV.Cells(Rows.Count, "A").End(3).Row
    
        c = Left(ShV.Cells(i, "C"), 1)
        If Not c = ce Then
            ce = c
            If Not SayfaVarMi(c) Then
                Sheets.Add After:=Worksheets(Worksheets.Count)
                ActiveSheet.Name = c
                ShV.Select
            End If
            j = Sheets(c).Cells(Rows.Count, "A").End(3).Row
        End If
        
        j = j + 1
        Range("A" & i & ":E" & i).Copy Sheets(c).Range("A" & j)
        
    Next i
End Sub

Kod:
Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
 

Ekli dosyalar

Necdet Hocam, Emeğiniz için çok teşekkür ediyorum. Çok sağ olun.
 
Geri
Üst