Sub sbCopyRangeToAnotherSheet()
'Set range
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy Destination:=Sheets("%").Range("I5")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I5").Select
'Paste in the target destination
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
=INDEX('JUPILER PRO LEAGUE'!F:F;LIGNE()-1-ENT((LIGNE()-5)/12))
=INDEX('JUPILER PRO LEAGUE'!D:D;LIGNE()-1-ENT((LIGNE()-5)/12))
=INDEX('JUPILER PRO LEAGUE'!K:K;LIGNE()-1-ENT((LIGNE()-5)/12))
Private Sub Worksheet_Activate()
Dim deb As Range, pas%, tablo, ncol%, resu, i&, ii&, jj%, j%, n&
Set deb = [G4] '1ère cellule de restitution, à adapter
pas = 11 'nombre de lignes de chaque journée
With Sheets("JUPILER PRO LEAGUE")
tablo = .Range("D3", .Range("K" & .Rows.Count).End(xlUp))
ncol = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo) + Application.CountIf(.[F:F], "JOURNEE*"), 1 To ncol - 2)
End With
'---remplissage du tableau et mises en forme---
Application.ScreenUpdating = False
deb.Resize(pas - 1, ncol - 2).ClearContents 'efface le contenu de la 1ère journée
For i = 1 To UBound(tablo)
ii = ii + 1
If i Mod pas = 1 Then '1ère ligne de chaque journée
If i > 1 Then
deb.EntireRow.Copy deb(ii).EntireRow 'copie la 1ère ligne
deb(2).Resize(pas - 2, ncol - 2).Copy deb(ii + 1) 'copie la 1ère journée pour les formats
End If
deb(ii, 12).Resize(pas - 1).BorderAround Weight:=xlMedium 'contour colonne R
n = n + 1
resu(ii, 1) = "JOURNEE"
resu(ii, ncol - 2) = n
Else
jj = 0
For j = 1 To ncol
jj = jj + 1
resu(ii, jj) = tablo(i, j)
If j = 1 Then j = 2 'saut de colonne
If j = ncol - 2 Then j = ncol - 1 'saut de colonne
Next j
End If
If i Mod pas = pas - 1 Then i = i + 1: ii = ii + 2 'sauts de lignes
Next i
ii = ii - 2 'évite les derniers sauts de lignes
'---restitution---
deb.Resize(ii, ncol - 2) = resu
deb.Offset(ii).EntireRow.Resize(Rows.Count - ii - deb.Row + 1).Delete 'RAZ en dessous
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Sub sbCopyRangeToAnotherSheet()
'Set range
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy Destination:=Sheets("%").Range("I5")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G4:H12").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I5").Select
'Paste in the target destination
ActiveSheet.Paste
Sheets("JUPILER PRO LEAGUE").Range("G15:H23").Copy Destination:=Sheets("%").Range("I17")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G15:H23").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I17").Select
'Paste in the target destination
Sheets("JUPILER PRO LEAGUE").Range("G26:H34").Copy Destination:=Sheets("%").Range("I29")
'Copy the data
Sheets("JUPILER PRO LEAGUE").Range("G26:H34").Copy
'Activate the destination worksheet
Sheets("%").Activate
'Select the target range
Range("I29").Select
'Paste in the target destination
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
La macro du post #5 s'exécute chez moi en 0,80 seconde et c'est vrai qu'on peut aller plus vite.comment faire plus rapide code vba
Private Sub Worksheet_Activate()
Dim deb As Range, pas%, tablo, ncol%, resu, i&, ii&, n&, jj%, j%
Set deb = [G4] '1ère cellule de restitution, à adapter
pas = 11 'nombre de lignes de chaque journée
With Sheets("JUPILER PRO LEAGUE")
tablo = .Range("D3", .Range("K" & .Rows.Count).End(xlUp))
ncol = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo) + Application.CountIf(.[F:F], "JOURNEE*"), 1 To ncol - 2)
End With
'---remplissage du tableau---
For i = 1 To UBound(tablo)
ii = ii + 1
If i Mod pas = 1 Then '1ère ligne de chaque journée
n = n + 1
resu(ii, 1) = "JOURNEE"
resu(ii, ncol - 2) = n
Else
jj = 0
For j = 1 To ncol
jj = jj + 1
resu(ii, jj) = tablo(i, j)
If j = 1 Then j = 2 'saut de colonne
If j = ncol - 2 Then j = ncol - 1 'saut de colonne
Next j
End If
If i Mod pas = pas - 1 Then i = i + 1: ii = ii + 2 'sauts de lignes
Next i
ii = ii - 2 'évite les derniers sauts de lignes
'---mise en forme et restitution---
Application.ScreenUpdating = False
deb.Resize(pas - 1, ncol - 2) = "" 'efface le contenu de la 1ère journée
deb.EntireRow.Resize(pas + 1).Copy deb(pas + 2).EntireRow.Resize((n - 1) * (pas + 1)) 'copier-coller pour la mise en formex
deb.Resize(ii, ncol - 2) = resu
deb.Offset(ii).EntireRow.Resize(Rows.Count - ii - deb.Row + 1).Delete 'RAZ en dessous
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
deb.Resize(pas - 1, ncol - 2).ClearContents 'efface le contenu de la 1ère journée
deb.Resize(pas - 1, ncol - 2) = "" 'efface le contenu de la 1ère journée