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 |
Livret scolaire
je suis à la recherche d'une macro ou du moins une aide pour le calcul de mes livrets scolaires qui prend me beaucoup beaucoup trop de temps...
Répondre avec citation
Marie
Partager