• DİKKAT

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

Aynı Hücreye Sayıları Yazmak

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?
Çok yöntem var ben tembelliğe kaçtım :)

Kod:
Sub Sirala()

    Dim i   As Integer, _
        Kol As Integer, _
        Dz  As String
        
    Application.ScreenUpdating = False
    
    Kol = Cells.Find("*", , , , xlByColumns, xlPrevious).Column + 1
    i = Cells(Rows.Count, "B").End(3).Row
    
    Range("B4:B" & i).Copy Cells(1, Kol)
    
    Range(Cells(1, Kol), Cells(i, Kol)).Sort Key1:=Cells(i, Kol)
    For i = 1 To Cells(Rows.Count, Kol).End(3).Row
        If Dz = "" Then
            Dz = Cells(i, Kol)
        Else
            Dz = Dz & "-" & Cells(i, Kol)
        End If
    Next i
    Columns(Kol).Delete
    Range("G3") = Dz
    Application.ScreenUpdating = True
    
End Sub
 
Geri
Üst