Ecrire et "archiver"
Hello
J'aurais voulu besoin que lorsque j'écris un mot dans la colonne A (N'importe où dans la colonne), ce mot se copie dans la colonne B (mais dans le premier espace libre de la colonne).
Puis si on efface un mot dans la colonne A (N'importe où), ce même mot se supprime de la colonne B si il y existe (faisant remonter les cellules pour ne pas laisser de vide (Sans suppression de lignes).
Dois je passer forcément par une macro ?
Merci d'avance
:)
Julien
Bonjour,
Je crois bien que oui et je ne vois pas comment vous pourriez y parvenir sans macro. Voici un essai :
'CODE A PLACER DANS LE MODULE DE LA FEUILLE
Public ValeurStockee As Variant
'MACRO SE DECLENCHANT AU CHANGEMENT DE SELECTION SUR LA FEUILLE
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then 'sur A, ssi un seul élément (target) est sélectionné
ValeurStockee = Target.Value 'ValeurStockee = valeur de la cellule (avant chgt)
End If
End Sub
'MACRO SE DECLENCHANT AU CHANGEMENT DE VALEUR SUR LA FEUILLE
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Count = 1 Then 'sur A, tjrs avec un seul élément, cette fois modifié
If Not ValeurStockee = "" And Target.Value <> ValeurStockee Then 'si ValeurStockee non vide et differente de la cellule modifiée
Call SuppValB 'exécution de la macro de suppression des cellules en B ayant la valeur ValeurStockee (càd valeur avant modif)
End If
If Not Target.Value = "" Then 'si la nouvelle valeur de la cellule modifiée est non vide
Call PremiereVideB(Target) 'exécution de la macro de remplissage de la 1ere cellule non vide en B avec la valeur de target (nvlle val)
End If
End If
End Sub
'MACRO POUR REMPLIR LA PREMIERE CELLULE VIDE EN B PAR LA VALEUR D'UNE CELLULE CibleA SPECIFIEE (CELLE MODIFIEE EN A)
Sub PremiereVideB(CibleA As Range)
Dim Bvides As Range
Set Bvides = Range("B:B").SpecialCells(xlCellTypeBlanks) 'ensemble des cellules vides en B
Bvides.Cells(1).Value = CibleA.Value 'la valeur de la 1ère cellule vide devient la valeur de CibleA (en l'occurrence la target en A)
End Sub
'MACRO POUR SUPPRIMER TOUTES LES CELLULES EN B AYANT UNE VALEUR SPECIFIEE (ValeurStockee : ancienne valeur effacée en A)
Sub SuppValB()
Dim Bcritere As Range
Set Bcritere = SpecificCells(Range("B:B"), ValeurStockee) 'ensemble des cellules en B valant ValeurStockee
If Not Bcritere Is Nothing Then 'si Bcritere n'est pas vide
Bcritere.Cells.Delete shift:=xlShiftUp 'suppression de toutes les cellules de Bcritere
End If
ValeurStockee = "" 'réinitialisation de ValeurStockee
End Sub
'FONCTION RETOURNANT L'ENSEMBLE DES CELLULES AYANT UNE VALEUR PRECISEE (Valeur_Critere)
Function SpecificCells(Plage As Range, Valeur_Critere As Variant) As Range
For Each cell In Plage 'pour chaque cellule de la plage
If cell.Value = Valeur_Critere Then 'si la cellule vaut Valeur_Critere
If SpecificCells Is Nothing Then 'si SpecificCells est vide (pas encore initialisé)
Set SpecificCells = cell 'SpecificCells contient la première cellule à l'alimenter
Else
Set SpecificCells = Union(SpecificCells, cell) 'sinon, SpecificCells est l'union du précédent SpecificCells et de la cellule en cours
End If
End If
Next
End FunctionJ'ai essayé de trouvé mieux pour la suppression des cellules mais ce n'est pas évident, du moins avec mes connaissances et ma version.
N'hésitez pas à limiter la zone d'application de ces 2 macros évènementielles à la zone effective pour accélérer leur exécution.
Cdlt,