XL 2016 Changer de feuille dans une macro

Syracoti

Syracoti

XLDnaute Nouveau
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
 
Solution
Staple1600
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
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Solution
Staple1600

Staple1600

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif
Syracoti

Syracoti

XLDnaute Nouveau
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
 

Pièces jointes

  • Test Collection Santon.xlsm
    34.8 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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. ;)
 
Vote positif 0 Vote négatif
Syracoti

Syracoti

XLDnaute Nouveau
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!! :D

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
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
Syracoti

Syracoti

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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 ;))
 
Vote positif 0 Vote négatif
Syracoti

Syracoti

XLDnaute Nouveau
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 ?
 
Vote positif 0 Vote négatif

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
426
ph.vanne
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
323
Phil69970
Phil69970
M
  • Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
184
MICHIS
M
micie1509
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
304
micie1509
micie1509
M
  • Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
16
Affichages
701
Phil69970
Phil69970
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
528
robpellan52
R
G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
173
sylvanu
sylvanu
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
V
  • Question
XL pour MAC outil coller le contenu du presse papier
Réponses
2
Affichages
548
Valter
V
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
636
gwenn49
G

Membres actuellement en ligne

7 membres et 98 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 096
Messages
2 116 184
Membres
112 677
dernier inscrit
Justine11