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 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
| Sub test()
Dim Eleves As Variant, Mat As Variant, Notes As Variant, Plage As Range, C As Range
Dim Lig As Integer, Col As Integer
With Sheets("Liste des élèves")
On Error Resume Next
For Each C In .Range("A3", .Cells(.Rows.Count, 1).End(xlUp))
With Sheets(C.Value)
.Name = C.Offset(, 1).Value
.[A2] = C.Offset(, 1).Value
End With
Next C
On Error GoTo 0
.Range("B3", .Cells(.Rows.Count, 2).End(xlUp)).Copy
Sheets("Tabeau source").[A3].PasteSpecial xlPasteValues
Sheets("Tabeau source").[A35].PasteSpecial xlPasteValues
End With
'Année 1
With Sheets("Tabeau source")
Notes = .Range("A3", .Cells(3, 1).End(xlDown)).Offset(, 1).Resize(, .Cells(2, .Columns.Count).End(xlToLeft).Column - 1)
Eleves = Application.Transpose(.Range("A3", .Cells(3, 1).End(xlDown)))
Mat = Application.Transpose(Application.Transpose(.Range("B1", .Cells(1, .Columns.Count).End(xlToLeft))))
End With
For i = 1 To Sheets.Count
With Sheets(i)
If .Name <> "Liste des élèves" And .Name <> "Tabeau source" Then
Set Plage = .Range("A4", .[A4].End(xlDown))
For j = 4 To Plage.Count + 3
Lig = Application.Match(.[A2], Eleves, 0)
Col = Application.Match(.Cells(j, 1), Mat, 0)
If Notes(Lig, Col) <> "" Then .Cells(j, 2).Value = Notes(Lig, Col)
If Notes(Lig, Col + 1) <> "" Then .Cells(j, 3).Value = Notes(Lig, Col + 1)
If Notes(Lig, Col + 2) <> "" Then .Cells(j, 4).Value = Notes(Lig, Col + 2)
Next j
End If
End With
Next i
'Année 2
With Sheets("Tabeau source")
Notes = .Range("A35", .[B35].End(xlDown)).Offset(, 1).Resize(, .Cells(34, .Columns.Count).End(xlToLeft).Column - 1)
' Notes = .Range("B35", .[B35].End(xlDown)).Resize(, .[34:34].Find("*", , , , xlByColumns, xlPrevious).Column - 1)
Eleves = Application.Transpose(.Range("A35", .Cells(35, 1).End(xlDown)))
Mat = Application.Transpose(Application.Transpose(.Range("B33", .Cells(33, .Columns.Count).End(xlToLeft))))
End With
For i = 1 To Sheets.Count
With Sheets(i)
If .Name <> "Liste des élèves" And .Name <> "Tabeau source" Then
Set Plage = .Range("A21", .[A21].End(xlDown))
For j = 21 To Plage.Row + Plage.Count - 1
Lig = Application.Match(.[A2], Eleves, 0)
Col = Application.Match(.Cells(j, 1), Mat, 0)
If Notes(Lig, Col) <> "" Then .Cells(j, 2).Value = Notes(Lig, Col)
If Notes(Lig, Col + 1) <> "" Then .Cells(j, 3).Value = Notes(Lig, Col + 1)
If Notes(Lig, Col + 2) <> "" Then .Cells(j, 4).Value = Notes(Lig, Col + 2)
Next j
End If
End With
Next i
End Sub |
Partager