Bom dia, tenho a seguinte macro:
Sub Sortear()
    Dim V() 'Vetor
    Dim CONT As Integer 'Contador
    Dim I As Integer 'Índice do vetor
    Dim QUANT_SORT As Integer 'Recebe o valor de quantos Nº aleatórios serão gerados
    Dim NUM_SORT As Integer 'Recebe um número sorteado
    Dim LIN As Integer 'Determina em que linha o Nº aleatório será colocado
    Dim REP As Integer 'Repetidor
    Dim VAL_MIN As Integer 'Recebe o valor mínimo na faixa de números
    Dim VAL_MAX As Integer 'Recebe o Valor máximo na faixa de números
    Dim FAIXA_SORT As Integer 'Faixa de valores possíveis ao sorteio
   
ActiveSheet.Name = "Sorteio"
On Error GoTo SAIDA
[E6:E65536].ClearContents
Range("E6:E65536").Font.Bold = True
Range("E6:E65536").Font.Size = 10
INICIO:
    VAL_MIN = InputBox("Qual será o MENOR número possível nesse sorteio?")
    VAL_MAX = InputBox("Qual será o MAIOR número possível desse sorteio?")
   
CHECA_VALOR_MAX:
   
    If VAL_MAX <= VAL_MIN Then
       If MsgBox("Você deve digitar um número MAIOR para o valor máximo ou alterar o valor mínimo. O Valor mínimo atual é " & VAL_MIN & ". Deseja Alterará-lo?", vbQuestion + vbYesNo + vbApplicationModal + vbDefaultButton1) = vbYes Then
           VAL_MIN = InputBox("Corrija o valor mínimo para o sorteio.")
              If VAL_MAX <= VAL_MIN Then
                GoTo CHECA_VALOR_MAX
              End If
       Else
           VAL_MAX = InputBox("Nesse caso digite um valor MAIOR que " & VAL_MIN & ". O valor máximo atual é " & VAL_MAX & ".")
              If VAL_MAX <= VAL_MIN Then
                GoTo CHECA_VALOR_MAX
              End If
       End If
    End If
                
FAIXA_SORT = VAL_MAX - VAL_MIN + 1
     
    QUANT_SORT = InputBox("Quantos números você deseja sortear?")
   
CHECA_FAIXA:
   
       If QUANT_SORT > FAIXA_SORT Then
          QUANT_SORT = InputBox("A quantidade de sorteios supera o valor máximo de números possíveis a serem sorteados sem repetições. Por favor corrija para um número MENOR ou IGUAl a " & FAIXA_SORT & ".")
          GoTo CHECA_FAIXA
       End If
      
       If VAL_MAX = VAL_MIN + 1 Then
            If MsgBox("Você determinou uma faixa muito estreita para a realização de um sorteio. Deseja Alterar os dados?", vbExclamation + vbYesNo + vbApplicationModal + vbDefaultButton1) = vbYes Then
                GoTo INICIO
            Else
                MsgBox "Não é possível realizar um sorteio com os números dados.", vbOKOnly + vbApplicationModal + vbCritical
                GoTo SAIDA
            End If
       End If
      
    Randomize
    For LIN = 1 To QUANT_SORT
        I = I + 1
        ReDim Preserve V(I)
REPETE:
        NUM_SORT = Int(rnd * VAL_MAX + VAL_MIN)
        REP = 0
        For CONT = I - LIN To I
            If NUM_SORT = V(CONT) Or NUM_SORT > VAL_MAX Then
                REP = 1
            End If
        Next
        If REP = 1 Then
            GoTo REPETE
        Else
            V(I) = NUM_SORT
        End If
    Next
    I = 0
    For LIN = 6 To QUANT_SORT
        I = I + 1
        Cells(LIN, 5) = V(I)
    Next LIN
SAIDA:
 ActiveWorkbook.Worksheets("Sorteio").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sorteio").Sort.SortFields.Add Key:=Range( _
        "E6:E55"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sorteio").Sort
        .SetRange Range("E6:E56")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Ele está funcionando normal, porém está sorteando 5 números a menos (o número de linhas que usei para criar o cabeçalho, borda, etc.) do que o usuário especifica.
Gostaria que alguém me ajudasse a encontrar aonde está o erro, se possível...
Muito obrigada pela atenção.
                                                                                                	"Only those who will risk going too far can possibly find out how far one can go."
 
                    
                    	
                            Postado : 24/08/2012 7:38 am