Değişik bir birleştirme ile ilgili yardım çok acil

[KURBA]

...........

 

[Necdet]

Merhaba,

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

Sayfa2 de bilgilerinizi düzenler. Başka yöntemlerle yapmak olası.
Bilgilerinizin Sayfa1 de 3. satırdan itibaren başladığı kabul edilmiştir.

Sub Duzenle()
    
    Dim s1      As Worksheet, _
        s2      As Worksheet
    
    Dim i       As Long
    Dim Kol     As Integer
    Application.ScreenUpdating = False
    
    Set s1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
        
    Kol = s1.Cells(3, "A").End(2).Column
    i = s1.Cells(Rows.Count, "A").End(3).Row
    
    s2.Cells.Clear
    
    s1.Range(s1.Cells(3, "A"), s1.Cells(i, Kol)).Copy s2.Range("A1")
    s2.Cells.EntireColumn.AutoFit
    
    i = i - 2
    
    s2.Select
    
    Range(Cells(2, "A"), Cells(i, Kol)).Sort Key1:=[C1], key2:=[D1]
    
    For i = i To 3 Step -1
        If Cells(i, "C") = Cells(i - 1, "C") And Cells(i, "D") = Cells(i - 1, "D") Then
            Cells(i - 1, "B") = Cells(i - 1, "B") & "-" & Cells(i, "B")
            Rows(i).Delete
        End If
    Next i
    
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    
    MsgBox "İşlem Tamamlanmıştır...", vbInformation, "N. YEŞERTENER"
    
End Sub

 

[Necdet]

Sözüm ona çok acil bir durumdu, ama soruyu soran arkadaşımız ortalıkta bile yok

 

[KURBA]

.....................

 

[Necdet]

hocam aldım. deniyordum. tamda istediğim şey. çok ama çok sağol. aklına sağlık.

Güle güle kullanınız hemşehrim