Beug sur code VBA

Bonjour

Je ne comprend pas pour quoi j'ai un beug dans ce code

Merci pour votre aide

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Sub CollerNomsAleatoirement()
    Dim ws As Worksheet
    Dim noms As Range
    Dim nomArray() As String
    Dim i As Long, j As Long
    Dim randomIndex As Long
    Dim temp As String

    ' Définir la feuille de calcul active
    Set ws = ThisWorkbook.ActiveSheet

    ' Définir la plage des noms à partir de A2
    Set noms = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)

    ' Mettre les noms dans un tableau
    nomArray = Application.Transpose(noms.Value)   'LE BEUG SE SITUE A CETTE LIGNE

    ' Mélanger le tableau de noms
    For i = UBound(nomArray) To LBound(nomArray) + 1 Step -1
        randomIndex = Int((i - LBound(nomArray) + 1) * Rnd + LBound(nomArray))
        temp = nomArray(i)
        nomArray(i) = nomArray(randomIndex)
        nomArray(randomIndex) = temp
    Next i

    ' Coller les noms aléatoirement dans la plage D2:H12
    For i = 0 To 9 ' 10 lignes
        For j = 0 To 4 ' 5 colonnes
            If (i * 5 + j) < UBound(nomArray) Then
                ws.Cells(2 + i, 4 + j).Value = nomArray(i * 5 + j)
            End If
        Next j
    Next i

    ' Mélanger à nouveau le tableau de noms pour la deuxième plage
    For i = UBound(nomArray) To LBound(nomArray) + 1 Step -1
        randomIndex = Int((i - LBound(nomArray) + 1) * Rnd + LBound(nomArray))
        temp = nomArray(i)
        nomArray(i) = nomArray(randomIndex)
        nomArray(randomIndex) = temp
    Next i

    ' Coller les noms aléatoirement dans la plage D16:H26
    For i = 0 To 9 ' 10 lignes
        For j = 0 To 4 ' 5 colonnes
            If (i * 5 + j) < UBound(nomArray) Then
                ws.Cells(16 + i, 4 + j).Value = nomArray(i * 5 + j)
            End If
        Next j
    Next i

    MsgBox "Les noms ont été collés aléatoirement dans les plages D2:H12 et D16:H26."
End Sub
'End Sub

Hello Joco7915,

Dim noms
noms = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row).value

nomArray = Application.Transpose(noms)

De mon téléphone portable

klin89

Bonjour et merci pour ta réponse

je joins le fichier avec explications

bonjour Joco7915, Klin89,

Dim nomArray '<<<<< faux déclaration, donc sans ()

et puis redimensioner pourque le LBound soit 0

nomArray = Application.Transpose(noms.Value) 'LE BEUG SE SITUE A CETTE LIGNE
ReDim Preserve nomArray(0 To UBound(nomArray) - 1) 'puis redimensioner mais conserver les données

Bonjour à tous,

Une autre manière de faire. Le code est commenté. Le code se trouve dans le module de Feuil1 :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim t, plages As Range, zone As Range, aux, n&, i&, j&

    t = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)      ' Définir le tableau  t des noms à partir de A2
    Set plages = Range("D2:G5,D7:G10,d12:f13,d15:e15")            ' Définir les plages où coller les noms

    Randomize                          ' initialiser le générateur de nombres aléatoires
    For Each zone In plages.Areas      ' pour chaque zone de plages
      ' mélange de t (tableau des noms)
      For i = 1 To UBound(t): n = 1 + Int(Rnd * UBound(t)): aux = t(i, 1): t(i, 1) = t(n, 1): t(n, 1) = aux: Next
      ' remplir chaque cellule de zone (jusqu'au minimum entre le nombre de noms et le nombre de cellules de la zone)
      ReDim r(1 To zone.Rows.Count, 1 To zone.Columns.Count)   ' le tableau résultat pour zone
      n = 0                                     ' le compteur de la cellule à traiter
      For i = 1 To zone.Rows.Count              ' pour chaque ligne de zone
         For j = 1 To zone.Columns.Count        ' pour chaque colonne de zone
            n = n + 1                           ' incrémentation du nombre de cellules traitées
            If n > UBound(t) Then Exit For      ' si n est sup. au nombre de noms, on quitte la boucle j (on a épuisé les noms)
            r(i, j) = t(n, 1)                   ' sinon on affecte à r(i,j) le nom t(n,1)
         Next j
         If n >= UBound(t) Then Exit For        ' si n est sup. au nombre de noms, on quitte la boucle i
      Next i
      zone = r                                  ' on transfère r sur zone
   Next zone
End Sub

Merci à vous tous

Affaire résolue

Crdlt