Hirdetés

Új hozzászólás Aktív témák

  • Delila_1

    veterán

    válasz Carasc0 #30874 üzenetére

    Tartományhoz (pl. C1:C25) használd a Konvertálatlan gombot.

    Sub Kever()
    Dim sor As Integer, sor1 As Integer

    Application.ScreenUpdating = False

    With Sheets("BÓNUSZ GENERÁTOROK")
    .Range("C1:C50").ClearContents
    .Range("A1:A50").Copy Range("C1")
    Randomize
    .Range("B1:B50") = "=RAND()"
    .Range("B1:B50").Copy
    .Range("B1").PasteSpecial xlPasteValues

    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:= _
    .Range("B1:B50"), SortOn:=xlSortOnValues, _
    Order:=xlAscending, DataOption:=xlSortNormal
    With .Sort
    .SetRange Range("B1:C50")
    .Header = xlGuess
    .Orientation = xlTopToBottom
    .Apply
    End With

    For sor = 1 To 20
    If Cells(sor, "C") = "" Then
    sor1 = Cells(sor, "C").End(xlDown).Row
    Cells(sor1, "C").Copy Cells(sor, "C")
    Cells(sor1, "C") = ""
    End If
    Next

    sor1 = Cells(sor, "C").End(xlDown).Row
    If Application.WorksheetFunction.CountA(Range("C23:C" & sor1 - 1)) = 0 Then _
    Range("C21:C" & sor1 - 1).Delete Shift:=xlUp
    sor1 = Cells(Rows.Count, "C").End(xlUp).Row

    For sor = sor1 To 21 Step -1
    Cells(sor, "C").Insert Shift:=xlDown
    Next

    sor1 = Cells(Rows.Count, "C").End(xlUp).Row
    If sor1 > 50 Then
    For sor = 50 To 45 Step -1
    If Cells(sor, "C") = "" Then
    Cells(sor, "C") = Cells(sor1, "C"): Cells(sor1, "C") = ""
    End If
    Next
    End If
    .Range("B1:B50").ClearContents
    .Cells(1).Select
    End With
    Application.ScreenUpdating = True
    End Sub

Új hozzászólás Aktív témák