Excel - VBA

Bonsoir,
Tu peux utiliser un code du type :

Sub nouvelle(nom, grade) 
Dim feuille As Worksheet 
For Each feuille In Worksheets(Array("effectif_actifs", "effectif_amicale","vacances")) 
    ' Ton code de copie des valeurs
Next feuille 
End Sub

@+

je ne comprends pas comment utiliser ce code en fait ....
Je comprends que le code que je devrais coller agirait sur plusieurs feuilles (effectif_actifs, effectif_amicale et vacances), mais je ne sais pas comment mettre le code qui va bien dessus ...

Sub nouvelle(nom As String, grade As String) 'insère une nouvelle feuille de donnée
'
' Déclaration des variables
Dim nom_2 As String
Dim grade_2 As String
Dim feuille As Worksheet
'
' Vérification des nom et grade
On Error GoTo er1
nom_2 = StrConv(Split(nom, " ")(0), vbUpperCase) & " " & _
  StrConv(Mid(Split(nom, " ")(1), 1, 1), vbUpperCase) & _
  Mid(Split(nom, " ")(1), 2)
grade_2 = StrConv(grade, vbUpperCase)

For Each feuille In Worksheets(Array("effectif_actifs", "effectif_amicale", "vacances"))
  feuille.Rows("5:5").Insert Shift:=xlDown
  feuille.Range("B5").Value = nom_2
  feuille.Range("C5").Value = grade_2
  With feuille.Range("B5:L5")
    .Interior.ColorIndex = xlNone
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
  End With
  For cal = 4 To feuille.Range("A10000").End(xlUp).Row
  '
  Next cal
  feuille.Range("B5:L5" & (cal - 1)).Sort Key1:=Range("B5"), Order1:=xlAscending, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Next feuille

Unload UserForm1
Exit Sub

er1:
MsgBox "Format Non Valide, Veuillez entrer un Nom, Espace et Prénom", vbCritical

End Sub

Je t'ai laissé ta formule pour extraire nom_2 mais elle me parait bizarre

J'ai modifier le truc grace à l'enregistreur de macro et le premier code donné plus haut ... voici ce que ça donne (j'ai encore une erreur à la fin ou c'est en gras !!!) :

Sub nouvelle(nom, grade) 'insère une nouvelle feuille de donnée

Sheets("effectif_actifs").Activate

nouvnom = Replace(nom, " ", "_")

On Error GoTo er1

n = StrConv(Split(nom, " ")(0), vbUpperCase) & " " & StrConv(Mid(Split(nom, " ")(1), 1, 1), vbUpperCase) & Mid(Split(nom, " ")(1), 2)

g = StrConv(grade, vbUpperCase)

Sheets(Array("effectif_actifs", "effectif_amicale", "vacances")).Select
    Rows("5:5").Select
    Selection.Insert Shift:=xlDown
    Sheets("effectif_actifs").Activate
Sheets("effectif_actifs").Range("B5").Value = n
Sheets("effectif_actifs").Range("C5").Value = g
Sheets("effectif_amicale").Range("B5").Value = n
Sheets("effectif_amicale").Range("C5").Value = g
Sheets("vacances").Range("B5").Value = n
Sheets("vacances").Range("C5").Value = g

Sheets(Array("effectif_actifs", "effectif_amicale")).Select
    Range("B5:L5").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
    Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
    Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
    Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Sheets("vacances").Select
    Range("B5:DF5").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
    Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
    Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
    Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
    Selection.Borders(xlInsideVertical).LineStyle = xlContinuous

Sheets("effectif_actifs").Activate
    
For cal = 4 To Sheets("effectif_actifs").Range("A10000").End(xlUp).Row

Next cal

c = cal - 1

Sheets("effectif_actifs").Range("B5:L5" & c).Sort Key1:=Range("B5"), Order1:=xlAscending, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
Sheets("effectif_amicale").Activate
    
For cal = 4 To Sheets("effectif_amicale").Range("A10000").End(xlUp).Row

Next cal

c = cal - 1

Sheets("effectif_amicale").Range("B5:L5" & c).Sort Key1:=Range("B5"), Order1:=xlAscending, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Sheets("vacances").Activate
    
For cal = 4 To Sheets("vacances").Range("A10000").End(xlUp).Row

Next cal

c = cal - 1

Sheets("vacances").Range("B5:DF5" & c).Sort Key1:=Range("B5"), Order1:=xlAscending, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal




Unload UserForm1

Exit Sub

er1:

MsgBox "Format Non Valide, Veuillez entrer un Nom, Espace et Prénom", vbCritical
Exit Sub

End Sub

en fait, mon code marche impec grace à vos idées et codes, j'ai pu "comprendre" ce que je faisais et là où ça plantait ... !!!
pour info, ça plantait dans la dernière feuille car j'avais des cellules fusionnées et donc ça ne prend pas le classement A-Z ...... dommage ! (y'a pas moyen de contourner ce problème en disant "sauf cette ligne" ...???).

Sinon petit soucis .... Avez vous une idée pour mettre devant les noms dans la colonne A le nombre de personne qui rentre ........ 1,2,3,4,5,........... automatiquement jusqu'au dernier personnel ..??

merci !!!!!!!!

Bonjour,
Juste une remarque, je pensais que tu ne voulais pas mettre tout le code mais j'ai un doute puisque tu le répète :

For cal = 4 To Sheets("vacances").Range("A10000").End(xlUp).Row
Next cal
c = cal - 1

Sert juste à ralentir ta macro, tu peux remplacer par :

c= Sheets("vacances").Range("A10000").End(xlUp).Row - 1

Sinon, une autre erreur est :

Sheets("vacances").Range("B5:DF5" & c).

à remplacer par :

Sheets("vacances").Range("B5:DF" & c).

Dans mon poste précédent, je te parlais de formule bizarre pour mettre en forme le nom, avec le recul, je me rend compte que ce n'est pas explicit : elle fonctionne certainement (je n'ai jamais utilisé cette syntaxe, j'utilise plutôt InStr, Left, Right)pour Paul Dupond mais je ne sais pas si elle te renvoie ce que tu souhaite pour les noms composé. J'utiliserais plutôt deux champs dans l'Userform un Nom et un Prénom.

Pour ta question, par exemple :

Dim compteur As Long
compteur = 0
While Range("B1").Offset(compteur,0).Value <>""
   Range("A1").Offset(compteur,0).Value = compteur + 1
Wend

@+

merci des codes envoyés, ils sont copiés et mis au chaud pour réutilisable ... sinon un ami au boulot qui gère aussi m'a fait un truc vite fait qui marche aussi ... :

Sheets("effectif_amicale").Activate

Set IP = ActiveWorkbook.Sheets("effectif_amicale")

For a = 5 To 1000

If IP.Cells(a, 2) <> "" Then
    IP.Cells(a, 1) = a - 4

End If

merci pour tes modifs, ça marche niquel !

autre question ?? ;)

Comment faire via un bouton "supprimer un nom" supprimer une ligne où se trouve des informations (nom prénom d'une liste) de la colonne B ...........??!!

encore merci !

bonsoir !

pour la question du dessus, je vais trouvé ...

j'ai un autre soucis ... : faire la somme de plusieurs cellules, d'une cellule connue de départ, à l'arrivée inconnu, jusque là pour "select" c'est sans soucis, mais pour en faire la somme ... je bute ... :(
En voici le code :

Sub moyage()
Sheets("effectif_amicale").Activate
c = Sheets("effectif_amicale").Range("A1000").End(xlUp).Row
Sheets("effectif_amicale").Range("L5:L" & c).Select
    ActiveCell.FormulaR1C1 = "=SUM()"
End Sub

merci

re :

J'ai trouvé en partie, mais je galère encore :(

j'arrive à afficher dans une msgbox la somme

Sub moyage()
Sheets("effectif_amicale").Activate
c = Sheets("effectif_amicale").Range("A1000").End(xlUp).Row
'MsgBox Worksheets("effectif_amicale").Range("L5:L" & c)
MsgBox Application.WorksheetFunction.Sum(Range("L5:L" & c)) / c
'    ActiveCell.FormulaR1C1 = "=SUM()"
End Sub

Comment pourrais je faire pour remplacer l'affichage par la somme divisé par le nombre de ligne sélectionnée .... ???

merci !

bon bon bon ... avec les heures qui défilent j'arrive très doucement à avancer ... j'arrive à afficher dans une cellule voulue le total :

Sub moyage()
Sheets("effectif_amicale").Activate
c = Sheets("effectif_amicale").Range("A1000").End(xlUp).Row
Sheets("effectif_amicale").Range("L25") = WorksheetFunction.Sum(Range("L5:L" & c))
End Sub

Reste plus qu'à trouver comment diviser cette somme par le nombre de cellules sélectionnées .....

UNE IDEE SVP ???

Bonsoir,
Après un grand week-end, je te répond enfin :-)

Post 8 :
Pour supprimer un nom, tu peux faire un userform avec des listes de choix sur les différents paramètres à rechercher, un bouton supprimer et un annuler. Ensuite, tu parcours les lignes de ton classeur à la recherche des critères. Du genre :

i=0 
While Range("B1").Offset(i,0).Value <> "" 
   If Range("B1").Offset(i,0).Value =critere_recherche Then 
      Rows(i).Delete Shift:=xlUp 
   Else 
      i = i + 1 
   End If 
Wend

Post 11 :

Sub moyage() 
Sheets("effectif_amicale").Activate 
c = Sheets("effectif_amicale").Range("A1000").End(xlUp).Row 
moyenne = WorksheetFunction.Sum(Range("L5:L" & c))/WorksheetFunction.CountA(Range("L5:L" & c)) 
End Sub

@+
Expérience: nom dont les hommes baptisent leurs erreurs.
Oscar Wilde