sütundaki adresleri sayfalara @ işaretinden sonraki ad ile sayfa açarak dağıt

[cems]

Çok yüksek miktarda email adreslerini bir excel sayfasında A sütununa yükledim ve "metni sütunlara dönüştür" yolu ile @ işaretinden önce ve sonraki veri olarak ayırdım. Daha sonra bu listeyi @ işaretinden sonraki harf sırasına A-Z ile soktum ve =birleştir fonksiyonu ile bu şekilde birleştirip server adına göre harf sıralı bir liste oluşturdum .

Devamında yapmak istediğim, server adına göre harf sıralı listede olan adresleri makro yolu ile o serverin adı ile yeni sayfa açıp listede olan ve aynı servere ait olan adresleri server adı ile açılan yeni sayfaya taşımak .

Bunu her excel kitabında 65000 satır için kullanmam gerekli ve ayrışacak data miktarı çok fazla yani makro kodunu belki 10 15 farklı excel worksheet için kullanmam gerekli

Bu konuda fikir ya da yardımlarınızdan mutlu olurum

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz. Sadece E sütunu kullanılmıştır..

Option Explicit
 
Sub ServerAdıAktar()
 
Dim i As Long, j As Integer, Sayfa As String
Dim S1 As Worksheet
 
Set S1 = Sheets("Elkt_Elektronik ")
Application.ScreenUpdating = False
 
S1.Select
For j = 1 To Worksheets.Count
    With Sheets(j)
        If .Name <> "Elkt_Elektronik " Then
            .[A:A].Clear
        End If
    End With
Next j
 
For i = 1 To S1.Cells(Rows.Count, "E").End(xlUp).Row
    Sayfa = Split(Split(S1.Cells(i, "E"), "@")(1), ".")(0)
 
    If Not SayfaVarMi(Sayfa) Then
        Sheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Sayfa
    End If
 
    S1.Cells(i, "E").Copy Sheets(Sayfa).Range("A" & _
        Sheets(Sayfa).Cells(Rows.Count, "A").End(xlUp).Row + 1)
     Sheets(Sayfa).Range("A:A").EntireColumn.AutoFit
 
Next i
 
Application.ScreenUpdating = True
End Sub
 
Function SayfaVarMi(SayfaAdi As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function

.

 

[cems]

Ömer bey,

Çok teşekkür ederim ,

kodlar tam beklenen sonucu verdi , gözlerinize elinize sağlık , zaman kazandırma açısından harika oldu bu.

Akıl akıldan üstündür