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 Function

J'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,

Rechercher des sujets similaires à "ecrire archiver"