XL 2016 Changer de feuille dans une macro

Syracoti · 20 Février 2022

Bonjour à tous!

J'ai suivi un tutoriel pour faire un formulaire de saisie avec un macro. Lors du tutoriel, la personne clique sur le bouton et tout s'ajoute dans la seconde feuille du classeur, jusque là rien d'anormal pour moi, à part le faire qu'on frôle la crise d'épilepsie car il effectue toutes les tâches en quelques secondes, et du coup change plusieurs fois de pages, ce qui fait clignoter l'écran.

J'aurai aimé savoir s'il est possible de faire en sorte que la macro se fasse de façon "invisible", ou du moins si le changement de feuille peut être invisible et rester sur la feuille du formulaire de bout en bout ?

Si jamais, je vous laisse le code de ma macro

VB:

Sub AjoutNouveauSanton()
'
' AjoutNouveauSanton Macro
'

'
    Range("C8").Select
    Sheets("Collection").Select
    Rows("19:19").Select
    Selection.Insert Shift:=xlDown
    Sheets("Formulaire").Select
    Selection.Copy
    Sheets("Collection").Select
    Range("B19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B19").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("C19").Select
    Sheets("Formulaire").Select
    Range("E8").Select
    Selection.Copy
    Sheets("Collection").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("D19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("F19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("I19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("G13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("H19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("C16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("G19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("J19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("G16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("K19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("C19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("L19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("M19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N19").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
    Rows("19:19").Select
    Range("D19").Activate
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("B19").Select
    Sheets("Formulaire").Select
    Range("C8").Select
End Sub

Merci pour votre temps et pour toute l'aide qui me sera apportée!

Edit: Je découvre Excel depuis peu! Et je suis encore en plein apprentissage de ses possibilités

Staple1600 · 20 Février 2022

Bonjour

Première piste
Supprimer autant que faire se peut les Select et Activate
Exemple, ceci
Range("C8").Select
Sheets("Collection").Select
Rows("19:19").Select
Selection.Insert Shift:=xlDown
peut se simplifier en
Sheets("Collection").Rows("19:19").Insert Shift:=xlDown

Et pour l'invisibilité, mettre en début de code
Application.ScreenUpdating = False

Staple1600 · 20 Février 2022

Bonjour

Première piste
Supprimer autant que faire se peut les Select et Activate
Exemple, ceci
Range("C8").Select
Sheets("Collection").Select
Rows("19:19").Select
Selection.Insert Shift:=xlDown
peut se simplifier en
Sheets("Collection").Rows("19:19").Insert Shift:=xlDown

Et pour l'invisibilité, mettre en début de code
Application.ScreenUpdating = False

Syracoti · 20 Février 2022

Ca fonctionne parfaitement! Merci beaucoup

Pour ce qui est de retirer les select, je pense que je verrai ça une autre fois!

Staple1600 · 20 Février 2022

Re

Suggestion en passant
Si tu peux joindre un fichier exemple (qui reproduit la structure originale de ton fichier, mais expurgé de données confidentielles), on pourrait plus facilement et rapidement t'aider.

Staple1600 · 20 Février 2022

Re

Comme ici le temps est gris, alors j'ai grisé la page blanche de mon VBE avec ces quelques lignes

VB:

Sub Essai_Simplification_AjoutNouveauSanton()
Dim ar, r As Range
Application.ScreenUpdating = False
ar = Sheets("Formulaire").Cells(1).CurrentRegion.Value2
Set r = Sheets("Collection").Cells(Rows.Count, "B").End(3)(2)
    r.Resize(, 12) = Array(ar(8, 3), ar(8, 5), ar(8, 7), Null, ar(13, 3), ar(13, 5), ar(13, 7), ar(16, 3), ar(16, 5), ar(16, 7), ar(19, 3), ar(19, 5))
    r.Offset(, 12).Formula = "=RC[-1]*RC[-2]"
    r.Borders.Weight = 2
    r.Borders(xlEdgeTop).LineStyle = xlNone
    r.Borders(xlEdgeBottom).LineStyle = xlNone
End Sub

Tu peux tester stp sur une copie de ton fichier et me redire si la macro ci-dessus donne le même résultat que ta macro initiale.
Merci.

Syracoti · 22 Février 2022

Bonjour!

Désolé pour le temps de réponse! J'ai donc testé le code que tu as fourni! Ce dernier semble fonctionner à merveille.

Avec un petit plus, ça créé les lignes en bas de toutes mes lignes existantes alors que dans ma macro originale, cela les créées en plein milieu du document, donc c'est top!

Cependant Dimanche, après que tu m'aies déjà aidé une première fois, j'avais "terminé" ma macro en ajoutant ta formule et d'autres manipulations.

Est-il possible de mélanger une partie de ton code avec le reste de ma macro ajouté dernièrement ?

Edit: Voici le fichier test sur lequel je travaille maintenant. On peut constater que suite aux dernières modifications, tout n'est pas collé au bon endroit

J'essaie de comprendre ce que tu m'as donné, toutefois je vois les infos de sélection de données mais je ne comprends pas comment il les colle à un endroit précis par la suite

Staple1600 · 22 Février 2022

Bonsoir

Voici le code avec des commentaires

VB:

Sub Essai_Simplification_AjoutNouveauSanton()
'Déclarations des variables
Dim ar, r As Range
'On fige l'écran
Application.ScreenUpdating = False
'ici on place le contenu de la feuille Formulaire en "mémoire" (en langae VBA: dans un array)
ar = Sheets("Formulaire").Cells(1).CurrentRegion.Value2
'ici on cherche la première cellule vide dans la colonne B de la feuille Collection
Set r = Sheets("Collection").Cells(Rows.Count, "B").End(3)(2)
'ici on "recopie" certaines valeurs stockées dans le tableau ar
    r.Resize(, 12) = Array(ar(8, 3), ar(8, 5), ar(8, 7), Null, ar(13, 3), ar(13, 5), ar(13, 7), ar(16, 3), ar(16, 5), ar(16, 7), ar(19, 3), ar(19, 5))
    r.Offset(, 12).Formula = "=RC[-1]*RC[-2]" ' ici on insère la  formule en colonne N
    'ici on formate les bordures
    r.Borders.Weight = 2
    r.Borders(xlEdgeTop).LineStyle = xlNone
    r.Borders(xlEdgeBottom).LineStyle = xlNone
    r.NumberFormat = "dd/mm/yyyy" ' ici on applique le format Date dans la cellule B
End Sub

Si tu as d'autres questions, n'hésites pas.

Syracoti · 23 Février 2022

Top! Tes commentaires sont justes parfaits! Je pense avoir compris le fonctionnement!

Par contre je me suis rendu compte que dans le fichier que j'ai laissé, c'est ta version de la macro que j'ai laissé et pas celle d'origine

Est-ce que je pourrais abuser de ta gentillesse en demandant si tu peux rajouter quelques trucs au code ?

Sur la macro finale, j'avais ajouté le fait qu'elle trie toutes les lignes, sauf celles de la nativité qui doivent rester en haut de document, par Univers, puis par Genre, puis par Ordre alphabétique sur les noms.
Et finir par revenir sur la fiche formulaire sur la première cellule, et avec tous les champs effacés

A nouveau si tu peux mettre les commentaires ce serait top!

Par avance si tu le fais, je te remercie mille fois pour toute ton aide apportée en plus de la question d'origine!!

Edit: Je te poste la macro complète ci-dessous si jamais ça t'est utile

VB:

Sub AjoutNouveauSanton()
'
' AjoutNouveauSanton Macro
'

'
    Application.ScreenUpdating = False
    Sheets("Collection").Select
    Rows("27:27").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("B27").Select
    Sheets("Formulaire").Select
    Selection.Copy
    Sheets("Collection").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("C27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("G8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("D27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("C13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("I27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("J27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("G13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("H27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("C16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("G27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("F27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("G16").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("K27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("C19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("L27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("E19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Collection").Select
    Range("M27").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("N27").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-2]"
    Rows("27:27").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "J27:J114"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "G27:G114"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Décors,Personnages,Animaux,Végétations", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "I27:I114"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Collection").Sort
        .SetRange Range("A27:T114")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "F27:F115"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "G27:G115"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Décors,Personnages,Animaux,Végétations", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "H27:H115"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Collection").Sort
        .SetRange Range("A27:T115")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B18").Select
    Sheets("Formulaire").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C19").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8").Select
End Sub

Staple1600 · 26 Février 2022

Bonjour,

Donc au final, tu reprends ton code initial avec plein de Select partout?
Pourquoi ne pas avoir remplacer dans ta macro originale , la portion de code par celle que je t'ai proposé?

Un autre exemple de simplication de ta macro
Cette simple ligne fait la même chose que le code VBA de ta macro que j'ai mis en bleu

VB:

'raz cellules sur feuille Formulaire
Sheets("Formulaire").Range("C8,E8,G8,C13,E13,G13,C16,E6,G16,C19") = ""

Enrichi (BBcode):


 Sheets("Formulaire").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C19").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8").Select

Syracoti · 26 Février 2022

Bonjour Staple, j'ai pas finaliser tout ça encore!

Le dernier code en date c'était avant que tu ne me propose une partie optimisée

Et du coup je voulais voir avec toi si c'était possible d'optimiser le reste de la même façon ?

J'ai essayé de fouiner un peu sur internet pour pouvoir faire le tri en vba, mais j'ai du mal à comprendre tout ça, et surtout je n'ai rien trouvé qui fasse commencer le tri à une ligne précise

Staple1600 · 26 Février 2022

Re

Relire mon précédent message, j'ai ajouté des choses.

Staple1600 · 26 Février 2022

Re

Logiquement, je me serai attendu à lire un truc du genre issu de ton VBA

VB:

Sub AjoutNouveauSanton()
'////////////// partie code Staple
'Déclarations des variables
Dim ar, r As Range
'On fige l'écran
Application.ScreenUpdating = False
'ici on place le contenu de la feuille Formulaire en "mémoire" (en langae VBA: dans un array)
ar = Sheets("Formulaire").Cells(1).CurrentRegion.Value2
'ici on cherche la première cellule vide dans la colonne B de la feuille Collection
Set r = Sheets("Collection").Cells(Rows.Count, "B").End(3)(2)
'ici on "recopie" certaines valeurs stockées dans le tableau ar
    r.Resize(, 12) = Array(ar(8, 3), ar(8, 5), ar(8, 7), Null, ar(13, 3), ar(13, 5), ar(13, 7), ar(16, 3), ar(16, 5), ar(16, 7), ar(19, 3), ar(19, 5))
    r.Offset(, 12).Formula = "=RC[-1]*RC[-2]" ' ici on insère la  formule en colonne N
    'ici on formate les bordures
    r.Borders.Weight = 2
    r.Borders(xlEdgeTop).LineStyle = xlNone
    r.Borders(xlEdgeBottom).LineStyle = xlNone
    r.NumberFormat = "dd/mm/yyyy" ' ici on applique le format Date dans la cellule B
'/////////////fin code Staple
'suite du code de la macro originale
Rows("27:27").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "J27:J114"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "G27:G114"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Décors,Personnages,Animaux,Végétations", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "I27:I114"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Collection").Sort
        .SetRange Range("A27:T114")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "F27:F115"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "G27:G115"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Décors,Personnages,Animaux,Végétations", DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Collection").Sort.SortFields.Add2 Key:=Range( _
        "H27:H115"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Collection").Sort
        .SetRange Range("A27:T115")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B18").Select
    Sheets("Formulaire").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C19").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C16").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C13").Select
    ActiveCell.FormulaR1C1 = ""
    Range("G8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("E8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8").Select
    ActiveCell.FormulaR1C1 = ""
    Range("C8").Select
End Sub

Staple1600 · 26 Février 2022

Re

Donc avec ce que j'ai compris
(et en se basant sur le fichier exemple, notamment au niveau des adresses des cellules)
Voici une simplification possible qui inclue le tri
NB: Pour tester, il faut affecter au bouton [Ajouter le Santon], la macro nommée Traitement.

VB:

Sub Traitement()
Application.ScreenUpdating = False
Ajouter_Santon
Appliquer_Tri
End Sub
Private Sub Ajouter_Santon()
Dim ar, r As Range
ar = Sheets("Formulaire").Cells(1).CurrentRegion.Value
Set r = Sheets("Collection").Cells(Rows.Count, "B").End(3)(2)
    r.Resize(, 12) = Array(ar(8, 3), ar(8, 5), ar(8, 7), Null, ar(13, 3), ar(13, 5), ar(13, 7), ar(16, 3), ar(16, 5), ar(16, 7), ar(19, 3), ar(19, 5))
    r.Offset(, 12).Formula = "=RC[-1]*RC[-2]"
    r.Borders.Weight = 2
    r.Borders(xlEdgeTop).LineStyle = xlNone
    r.Borders(xlEdgeBottom).LineStyle = xlNone
End Sub
Private Sub Appliquer_Tri()
Dim F As Worksheet: Set F = Sheets("Collection")
With Sheets("Collection").Sort
     .SortFields.Clear
     .SortFields.Add Key:=Range("F3"), Order:=1
     .SortFields.Add Key:=Range("G3"), Order:=1, CustomOrder:="Décors,Personnages,Animaux,Végétations"
     .SortFields.Add Key:=Range("H3"), Order:=1
     .SetRange F.Range(F.Cells(3, "b"), F.Cells(Rows.Count, "N").End(xlUp))
     .Header = xlYes
     .Apply
End With
End Sub

PS: On pourrait mettre tout dans la même macro.
Mais c'est sciemment que j'ai scindé
(Normalement, si tu es curieux, cette scission devrait te faire me poser des questions )

Syracoti · 26 Février 2022

Merci beaucoup! Tu es un vrai chef!

Tu l'as créer en deux fois car le code VBA aurait fait toutes les tâches en simultanée alors que la macro prend l'ordre des saisies en charge ?

Du coup ça permet de donner un ordre de traitement et de faire en sorte que le tri aie lieu après l'entrée du santon dans la liste ?

Staple1600 · 26 Février 2022

Re

Je pensais plus que tu m'aurais demandé:
Pourquoi on ne voit qu'une macro quand dans l'onglet Développeur on appuie sur Macros?

XL 2016 Changer de feuille dans une macro

Syracoti

XLDnaute Nouveau

Staple1600

Staple1600

XLDnaute Barbatruc

Syracoti

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Syracoti

XLDnaute Nouveau

Pièces jointes

Staple1600

XLDnaute Barbatruc

Syracoti

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Syracoti

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Syracoti

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Discussions similaires