Extraction ligne tirage LOTO

[NICOALBERT]

Bonjour le Forum ,

J'aurais voulu savoir si il y avait la possibilité d'extraire (via une macro) les lignes de tirage du loto après le tirage d'un numéro précis .

Exemple si le N° 1 est sorti copier la ligne suivante (en vert dans l'exemple) et cela pour chaque N° 1 de la feuille "Base" Hors N° chance .

Cordialement Nicoalbert .

 

[Yurperqod]

Bonjour le forum

Un essai

Sub test()
Dim v_DL As Long, v_L As Long, Plage As Range
v_DL = Range("A" & Rows.Count).End(xlUp).Row
For v_L = 2 To v_DL
Set Plage = ActiveSheet.Range(ActiveSheet.Cells(v_L, "B"), ActiveSheet.Cells(v_L, "F"))
If Application.WorksheetFunction.CountIf(Plage, 1) = 1 Then
Plage.Offset(1).Copy Feuil2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
End If
Set Plage = Nothing
Next
End Sub

 

[Yurperqod]

Pour avoir la date et le numéro chance

Sub testV2()
Dim v_DL As Long, v_L As Long, Plage As Range
v_DL = Range("A" & Rows.Count).End(xlUp).Row
For v_L = 2 To v_DL
Set Plage = ActiveSheet.Range(ActiveSheet.Cells(v_L, "B"), ActiveSheet.Cells(v_L, "F"))
If Application.WorksheetFunction.CountIf(Plage, 1) = 1 Then
Plage.Offset(1, -1).Resize(, 7).Copy Feuil2.Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)
End If
Set Plage = Nothing
Next
End Sub

 

[NICOALBERT]

Bonjour Yurperqod ,

Tout d'abord un grand merci pour le temp que tu a pris pour me répondre .

Lorsque je modifie le N° sélectionner dans la feuil2 c'est toujours la même extraction .

Peut être est ce moi qui me trompe dans la manip !!

 

[Hieu]

Salut,

Une idée :

Sub tirage()
Application.ScreenUpdating = False
Sheets("Extraction").Columns("b:h").Clear
num = Sheets("Extraction").Range("a3")
Set boule = Sheets("Base").Range("b1:f1")

For i = 1 To 1225
    For Each r In boule.Offset(i, 0)
        If r = num Then
        Sheets("Base").Range("a1:g1").Offset(i + 1).Copy
        Sheets("Extraction").Range("b2").Offset(k, 0).PasteSpecial
        k = k + 1
        Exit For
        End If
    Next r
Next i
End Sub

 

[NICOALBERT]

Bonjour Hieu ,

Merci pour ce code c'est tout à fait cela , c'est nickel , un grand merci .
Est ce que c'est possible la même chose avec plusieurs n° ou pas .

Exemple je sélectionne deux ou trois n° par exemple .

 

[Yurperqod]

Il faut changer le numéro dans cette ligne
If Application.WorksheetFunction.CountIf(Plage, 1) = 1 Then
par exemple si on cherche pour le numéro 5
If Application.WorksheetFunction.CountIf(Plage, 5) = 1

 

[Hieu]

Une petite modif à la va-vite :

Sub tirage()
Application.ScreenUpdating = False
Sheets("Extraction").Columns("b:h").Clear
num1 = Sheets("Extraction").Range("a3")
num2 = Sheets("Extraction").Range("a4")
Set boule = Sheets("Base").Range("b1:f1")

For i = 1 To 1225
test1 = False
test2 = False
    For Each r In boule.Offset(i, 0)
    If r = num1 Then test1 = True
    If r = num2 Then test2 = True
        If test1 And test2 = True Then
        Sheets("Base").Range("a1:g1").Offset(i + 1).Copy
        Sheets("Extraction").Range("b2").Offset(k, 0).PasteSpecial
        k = k + 1
        Exit For
        End If
    Next r
Next i
End Sub

 

[NICOALBERT]

Un grand merci à Hieu et à Yurperqod .