Re,Re
Oui ,JBARBE est un pro pour les macros, et formules
Guido
Sub Transfert()
Dim Fs As Worksheet, Fd As Worksheet, Ps, Pd, i&, j%, c As Range, lig As Variant, k%
Set Fs = Sheets("PRONO_DE_Base") 'feuille source, à adapter
Set Fd = Sheets("PRONO_NET") 'feuille de destination, à adapter
Ps = Array("A7", "R9", "R11:X12") 'adresses des plages sources, à adapter
Pd = Array("A7", "D9", "D11:J12") 'adresses des plages de destination, à adapter
For i = 1 To 271 Step 30
For j = 1 To 79 Step 13
Set c = Fd.Cells(i, j)
lig = Application.Match(Trim(c) & " *", Fs.Columns(1), 0)
For k = 0 To UBound(Ps)
If IsError(lig) Then c.Range(Pd(k)) = "" Else c.Range(Pd(k)) = Fs.Cells(lig, 1).Range(Ps(k)).Value
Next k, j, i
Fd.Activate 'facultatif
End Sub
Re
je pense que le fil est clot ,
mais je n'ai pas compris le Principe de ce "Classement avec doublon"
je vais tenter de comprendre en repartant du début Lol(je vais chercher le Fil)
Bonne fin de journée
Amicalement
Jean marie
Si par exemple on veut renseigner aussi les cellules D8 et D13:J13 on utilisera :(on peut alors les adapter comme on veut)
Sub Transfert()
Dim Fs As Worksheet, Fd As Worksheet, Ps, Pd, i&, j%, c As Range, lig As Variant, k%
Set Fs = Sheets("PRONO_DE_Base") 'feuille source, à adapter
Set Fd = Sheets("PRONO_NET") 'feuille de destination, à adapter
Ps = Array("A7", "R8:R9", "R11:X13") 'adresses des plages sources, à adapter
Pd = Array("A7", "D8:D9", "D11:J13") 'adresses des plages de destination, à adapter
For i = 1 To 271 Step 30
For j = 1 To 79 Step 13
Set c = Fd.Cells(i, j)
lig = Application.Match(Trim(c) & " *", Fs.Columns(1), 0)
For k = 0 To UBound(Ps)
If IsError(lig) Then c.Range(Pd(k)) = "" Else c.Range(Pd(k)) = Fs.Cells(lig, 1).Range(Ps(k)).Value
Next k, j, i
Fd.Activate 'facultatif
End Sub
Private Sub Worksheet_Activate()
Initialise_Reunions
End Sub
Bonjour Guido
Bonjour Le Fil ,Le Forum
(un coucou particulier à Job75)
une approche de ce que j'ai cru comprendre Lol
Question : peut il y avoir dans la feuille "PRONO_DE_BASE" des erreur du genre le Gagnant n'est pas dans la Liste des arrivées "ex en R9 il y a 14 et pas dans la plage Q12:X12
ou l'indication du nombre de partants en A7 , sans indication de Course en A1 etc etc
ou est ce une erreur de mise en forme lors de la mise sur le Forum ?
la procédure a été mise dans la méthode :
pourrais tu m'expliquer comment ce passe la démarche ?VB:Private Sub Worksheet_Activate() Initialise_Reunions End Sub
tu récupères en "PRONO_DE_BASE" ex : en Q12:X12 les pronostics , puis ensuite tu mets toi le Gagnant ?
Essai de m'expliquer , merci para avance
Tu testes et tu me dis , si j'ai compris Lol
Bonne journée
Amicalement
Jean marie
Sub Transfert()
Dim Fs As Worksheet, Fd As Worksheet, Ps, Pd, i&, j%, c As Range, lig As Variant, k%, g
Set Fs = Sheets("PRONO_DE_Base") 'feuille source, à adapter
Set Fd = Sheets("PRONO_NET") 'feuille de destination, à adapter
Ps = Array("A7", "R9", "R11:X12") 'adresses des plages sources, à adapter
Pd = Array("A7", "D9", "D11:J12") 'adresses des plages de destination, à adapter
Application.ScreenUpdating = False
For i = 1 To 271 Step 30
For j = 1 To 79 Step 13
Set c = Fd.Cells(i, j)
lig = Application.Match(Trim(c) & " *", Fs.Columns(1), 0)
For k = 0 To UBound(Ps)
If IsError(lig) Then c.Range(Pd(k)) = "" Else c.Range(Pd(k)) = Fs.Cells(lig, 1).Range(Ps(k)).Value
Next k
'---gagnant en tête de la ligne TTG---
g = c.Range(Pd(1)) 'gagnant
With c.Range(Pd(2)).Rows(2)
If g <> "" And g <> .Cells(1) Then
For k = 2 To .Columns.Count
If .Cells(k) = g Then .Cells(k).Cut: .Cells(1).Insert: Exit For 'couper-insérer
Next k
End If
End With
Next j, i
Fd.Activate 'facultatif
End Sub