bonjour
j'ai 2 macros, l'une pour le loto et elle fonctionne trés bien, l'autre pour euromillion et la j'ai le message erreur 1004
C'est la ligne " DeltaV = Application.WorksheetFunction.Max(rg) " qui est surligné en jaune.
je ne comprends pourquoi elle marche sur l'un et pas sur l'autre
merci
j'ai 2 macros, l'une pour le loto et elle fonctionne trés bien, l'autre pour euromillion et la j'ai le message erreur 1004
C'est la ligne " DeltaV = Application.WorksheetFunction.Max(rg) " qui est surligné en jaune.
je ne comprends pourquoi elle marche sur l'un et pas sur l'autre
merci
Code:
Option Explicit
Sub Macro12()
'
' Macro12
' transfert des données vers EM1
'
Dim wsData As Worksheet, wsR1 As Worksheet, wsR2 As Worksheet, rg As Range, larg%
'Dim wsR3 As Worksheet, wsR4 As Worksheet, wsR5 As Worksheet
'Dim wsR6 As Worksheet, rg As Range, larg%
Dim Série1 As Variant, Série2 As Variant
Dim i%, j%, k%, M%, n%, o%, p%, nLg%, jmax%, Départ%
Dim rmax%, rCol%, DeltaV%, rLig() As Integer
'----------- Lignes à modifier selon convenance --------------
Départ = 2 'N° de la première ligne des résultats
Set wsData = Worksheets("EuroMil") ' feuille contenant les données
Set wsR1 = Worksheets("EM1") ' feuille contenant les réultats
wsData.Range("B1") = "tirages" ' impose un titre à la base de données
'------------------------------------------------------------
i = 2 'N° de la première ligne des données
Application.ScreenUpdating = False
With wsData
.Range("B2").Select
Set rg = .Range("B2").CurrentRegion
Set rg = rg.Offset(1, 1).Resize(rg.Rows.Count - 1, rg.Columns.Count - 1)
larg = rg.Columns.Count 'nbre de données sur une ligne
DeltaV = Application.WorksheetFunction.Max(rg)
ReDim rLig(DeltaV)
jmax = Int(Application.Columns.Count / (larg + 1))
' inscription du N° des blocs de résultats
For j = 1 To DeltaV: rLig(j) = Départ - 1
If j <= jmax Then
wsR1.Cells(rLig(j), (larg + 1) * (j - 1) + 1) = j
ElseIf j <= 2 * jmax Then
Else
MsgBox "Trop de feuilles résultats exigées. Modifier la macro ou modifier les données."
End
End If
Next j
Série1 = .Range(.Cells(i, 2), .Cells(i, larg + 1)).Value
rmax = jmax * (larg + 1)
' répartition des données dans les blocs
While i <= rg.Rows.Count
i = i + 1
Série2 = .Range(.Cells(i, 2), .Cells(i, larg + 1)).Value
For j = LBound(Série1, 2) To UBound(Série1, 2)
rLig(Série1(1, j)) = rLig(Série1(1, j)) + 1
nLg = rLig(Série1(1, j))
rCol = (Série1(1, j) - 1) * (larg + 1) + 1
If rCol <= 0 Then MsgBox "Pas de valeur nulle dans les données. Veuillez corrigez.": Exit Sub
If rCol < rmax Then
wsR1.Range(wsR1.Cells(nLg, rCol), wsR1.Cells(nLg, rCol + larg - 1)) = Série2
ElseIf rCol < 2 * rmax Then
Stop
End If
Next j
Série1 = Série2
Wend
End With
Application.ScreenUpdating = True
End Sub