Macro de recopie sous condition

Version imprimable

20/02/2023, 20h31
LeSInge35

1 pièce(s) jointe(s)

Macro de recopie sous condition

Bonjour à tous,

Je me casse un peu la tête sur du VBA en ce moment (autant Excel je me débrouille mais alors les macro..), j'espère que vous pourrez m'aider.

J'ai prévu un tableau (avec couleur) pour que ma demande soit plus parlante.

Je souhaiterai avoir une macro qui copie le cellule d'une feuille (entree) dans une autre (sortie). Sur la feuille "entrée", la colonne d'entête des lignes (sport) doit être copiée dans la feuille "sortie" avec les données de la première colonne de donnée (score) et à chaque bout de ligne le nom de l’élève.
La macro doit faire le même exercice sur le deuxième élèves, puis le troisième, ... , elle s’arrête quand l’entête de la colonne est "total sport"

Merci par avance,
21/02/2023, 09h11
BENNASR

1 pièce(s) jointe(s)

bonjour
pas besoin de VBA, PowerQuery est dédié pour ce genre de traitement
1/ insérer un tableau et pas besoin de réserver une colonne et une ligne pour les totaux
2/ démarre PowerQuery
3/ Charger tes données
4/ Clic droite avec le souris sur la première colonne et choisir dépivoter les autres colonnes
5/ charger tes données

Pour une raison que j'ignore tu préfère VBA
teste :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub regroup()
Application.ScreenUpdating = False
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("Entree")
Set F2 = Sheets("Sortie")
F2.Cells.ClearContents
Dim i As Long
On Error Resume Next
Set d = CreateObject("Scripting.Dictionary")
F2.Cells(1, 1) = "sport"
F2.Cells(1, 2) = "jours"
F2.Cells(1, 3) = "éleve"
 
    TblBD = F1.Range("A1:D" & F1.Range("D" & Rows.Count).End(xlUp).Row)
    For i = 2 To UBound(TblBD) - 1
    For col = 2 To 4
    clé = TblBD(i, 1) & "|" & TblBD(i, 2) & "|" & TblBD(1, col)
    d(clé) = d(clé)
    Next col
    Next i
 
 F2.Range("A2").Resize(d.Count) = Application.Transpose(d.keys)
 Application.DisplayAlerts = False
 F2.Range("A2").Resize(d.Count).TextToColumns Other:=1, OtherChar:="|"
Application.ScreenUpdating = True
End Sub

21/02/2023, 19h54
LeSInge35

Bonjour BENNASR,

Merci beaucoup pour ton aide, effectivement Query est parfait pour résoudre ma problématique.

Je clos !
Bonne soirée,