Excel - VBA
Résolu
J0K0
Messages postés
163
Date d'inscription
Statut
Membre
Dernière intervention
-
Gord21 Messages postés 918 Date d'inscription Statut Membre Dernière intervention -
Gord21 Messages postés 918 Date d'inscription Statut Membre Dernière intervention -
bonsoir à toutes et tous,
Voilà mon soucis :
Sous excel, j't'utilise un code pour copier d'un "userform" 2 cellules et les coller d'une feuille .... (en gros hein ...) j'aimerais le faire sur plusieurs feuilles (copier les mêmes infos aux mêmes endroits), comment faire .... ??
- feuille de base : effectif_actifs
- copie sur : effectif_amicale, vacances
Voici ce code :
ça doit être simple quand on connait ... Moi je récupère des bouts de code par ci par là, et j'adapte ....
Merci de votre aide !
Joko
Voilà mon soucis :
Sous excel, j't'utilise un code pour copier d'un "userform" 2 cellules et les coller d'une feuille .... (en gros hein ...) j'aimerais le faire sur plusieurs feuilles (copier les mêmes infos aux mêmes endroits), comment faire .... ??
- feuille de base : effectif_actifs
- copie sur : effectif_amicale, vacances
Voici ce code :
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("effectif_actifs").Rows("5:5").Select
Selection.Insert Shift:=xlDown
Sheets("effectif_actifs").Range("B5").Value = n
Sheets("effectif_actifs").Range("C5").Value = g
Sheets("effectif_actifs").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
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
'For i = 4 To Sheets("effectif_actifs").Range("A10000").End(xlUp).Row
'If Cells(i, 1).Value = n Then Exit For
'Next i
Next 'à remplacer par ??????
Sheets("effectif_amicale").Rows("5:5").Select
Selection.Insert Shift:=xlDown
Sheets("effectif_amicale").Range("B5").Value = n
Sheets("effectif_amicale").Range("C5").Value = g
Sheets("effectif_amicale").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
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
'For i = 4 To Sheets("effectif_amicale").Range("A10000").End(xlUp).Row
'If Cells(i, 1).Value = n Then Exit For
'Next i
'Sheets("vierge").Cells.Copy
'Sheets.Add
'ActiveSheet.Name = nouvnom
'ActiveSheet.Paste
'ActiveSheet.Range("A5").Value = n
'ActiveSheet.Range("B5").Value = g
'ActiveWindow.Zoom = 50
'If i = Sheets.Count + 1 Then
'ActiveSheet.Move after:=Sheets(Sheets.Count)
'Else
'ActiveSheet.Move before:=Sheets(i)
'End If
Unload UserForm1
Exit Sub
er1:
MsgBox "Format Non Valide, Veuillez entrer un Nom, Espace et Prénom", vbCritical
Exit Sub
End Sub
ça doit être simple quand on connait ... Moi je récupère des bouts de code par ci par là, et j'adapte ....
Merci de votre aide !
Joko
A voir également:
- Excel - VBA
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Déplacer colonne excel - Guide
- Si ou excel - Guide
- Excel compter cellule couleur sans vba - Guide
11 réponses
Bonsoir,
Tu peux utiliser un code du type :
@+
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 ...
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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 !!!!!!!!
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 :
Sert juste à ralentir ta macro, tu peux remplacer par :
Sinon, une autre erreur est :
à remplacer par :
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 :
@+
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 ... :
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 !
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 :
merci
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
Comment pourrais je faire pour remplacer l'affichage par la somme divisé par le nombre de ligne sélectionnée .... ???
merci !
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 :
Reste plus qu'à trouver comment diviser cette somme par le nombre de cellules sélectionnées .....
UNE IDEE SVP ???
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 :
Post 11 :
@+
Expérience: nom dont les hommes baptisent leurs erreurs.
Oscar Wilde
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
Sheets("effectif_actifs").Rows("5:5").Select Selection.Insert Shift:=xlDown Sheets("effectif_actifs").Range("B5").Value = n Sheets("effectif_actifs").Range("C5").Value = g Sheets("effectif_actifs").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 = xlContinuousPar :
With Sheets("effectif_actifs") .Rows("5:5").Insert Shift:=xlDown .Range("B5").Value = n .Range("C5").Value = g End With With Sheets("effectif_actifs").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