Re : Amélioration document excel - Gestion bénévoles (planning/listings)
Ouaw, Merci beaucoup Sisco pour ce travail. J'ai mis beaucoup de temps à répondre parce qu'étant débutant, il m'a fallu beaucoup de temps pour comprendre ce que tu avais fait ! Quel savoir faire !
J'ai entre temps reçu en message privé (étrange !) une autre proposition qui a l'air d'être intéressante également (macro). Dis moi ce que tu en penses ?
Private Sub CommandButton1_Click()
Dim Ligne
Dim Col
Dim nom As String
Dim temp
Dim ExcluList As Collection
Set ExcluList = New Collection
ExcluList.Add ("fantomas")
Ligne = 3
Total = Worksheets.Count
For i = 3 To Total
Worksheets(3).Delete
Next i
While Worksheets("Tout").Cells(Ligne, 1).Value <> Empty
' nom en maj
Worksheets("Tout").Cells(Ligne, 1).Value = UCase(Worksheets("Tout").Cells(Ligne, 1).Value)
For Col = 3 To 58
If Worksheets("Tout").Cells(Ligne, Col).Value <> Empty Then
nom = Worksheets("Tout").Cells(Ligne, Col).Value
If Len(nom) > 25 Or InStr(nom, "?") <> 0 Then
If vbNo = MsgBox("Ton nom de catégorie est bien trop long (ou tu as mis un caractère interdit) !!! " _
+ vbCrLf + "allez je suis sympa : " + nom + vbCrLf + "Est ce bien une catégorie ??", vbYesNo) Then
ExcluList.Add (nom)
GoTo finCase
Else
GoTo fin
End If
End If
On Error Resume Next
Worksheets(nom).Cells(2, 1).Value = nom ' copie de la catégorie
' Worksheets(nom).Cells(2, 1).Interior.Color = RGB(255, 0, 0)
Worksheets(nom).Cells(2, 1).Font.Bold = True
Worksheets(nom).Cells(2, 1).Font.Size = 22
If Err.Number <> 0 Then ' si on n'a pas l'onglet ça fait une erreur qu'on récuper pour créer le nv onglet
Worksheets.Add(, Sheets(Sheets.Count)).Name = Worksheets("Tout").Cells(Ligne, Col).Value
Worksheets("Tout").Range("A" & 1 & ":EB" & 2).Copy
Worksheets(nom).Range("A" & 3).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
' tant qu'il y a un nom et que ce n'est pas le nom de la personne (pour éviter les doubles inscriptions)
temp = 5
While (Worksheets(nom).Cells(temp, 1).Value <> Empty) And (Worksheets(nom).Cells(temp, 1).Value <> Worksheets("Tout").Cells(Ligne, 1).Value)
temp = temp + 1
Wend
' on a trouvé où coller : on colle !
Worksheets("Tout").Range("A" & Ligne & ":EB" & Ligne).Copy
Worksheets(nom).Range("A" & temp).PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Worksheets(nom).Range("A" & temp).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' onpoursuit en cherchant le dernier nom pour compter le nombre
While (Worksheets(nom).Cells(temp, 1).Value <> Empty)
temp = temp + 1
Wend
Worksheets(nom).Cells(2, 8).Value = temp - 5
' For i = 1 To 130
' Worksheets(nom).Cells(temp, i).Value = Worksheets("Tout").Cells(Ligne, i).Value
' Next i
End If
finCase:
Next Col
Ligne = Ligne + 1
Wend
fin:
End Sub
Private Sub CommandButton2_Click()
For i = 2 To Worksheets.Count
Worksheets(i).Range("A" & 3 & ":EB" & 100).Delete
Next i
End Sub