Archivage dans une autre feuille

Bonjour,

Je viens pour avoir de l'aide car malgré mes recherches et mes tests de formules je n'arrive pas à ce que je veux.

En fait je voudrai que lorsque j'ajoute une date dans la colonne K, la ligne complète soit coupée et collée dans la feuille "temp".

pour l'instant j'ai bien réussi à la copier mais pas à la couper (il reste des lignes vides dans ma feuille "base").

Ci-dessous le code avec lequel j'ai tenté des choses :

Sub archives_auto() a = Worksheets("Base").Cells(Rows.Count, 1).End(xlUp).Row For i = 6 To a If Worksheets("Base").Cells(i, 13).value <> "" Then Worksheets("Base").Rows(i).Cut Worksheets("temp").Activate b = Worksheets("temp").Cells(Rows.Count, 1).End(xlUp).Row Worksheets("temp").Cells(b + 1, 1).Select ActiveSheet.Paste End If Next End Sub

Merci de votre aide !

Bonsoir,

Changer ta formule en A au profit d'une pouvant résister aux suppressions de lignes (voir fichier).

Evènementielle intervenant sur saisie de dates en K :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LgB As Range, c As Range, cc As Range, nT&
    If Target.Row < 6 Then Exit Sub
    Set cc = Intersect(Target, Me.Columns("K"))
    If Not cc Is Nothing Then
        Application.EnableEvents = False
        For Each c In cc
            If IsDate(c) Then
                Set LgB = Me.Range("A" & c.Row).Resize(, 14)
                With Worksheets("Temp")
                    nT = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                    .Range("A" & nT).Resize(, 14).Value = LgB.Value
                End With
                LgB.Delete xlShiftUp
            End If
        Next c
        Application.EnableEvents = True
    End If
End Sub

Cordialement.

Ça marche parfaitement, merci beaucoup !

Et petite question, si je veux exécuter ta macro seulement quand je le souhaite (avec un bouton), faut lui changer quels éléments?

Là elle n'intervient que sur la zone modifiée... automatiquement. Pour supprimer cet automatisme, il faut la revoir pour qu'elle boucle sur tout le tableau afin de transférer les lignes qui répondent aux conditions.

La partie intérieure à la boucle ne changera pas, ce qui l'entoure est à modifier...

Est-ce que je peux être chiant et te demander de l'aide pour cette macro?

Bonjour,

Une méthode un peu différente finalement :

Sub Transférer()
    Dim Tft(), cc, lgS, nT&, i&, ii&, n&
    With Worksheets("Base").Range("A5").CurrentRegion
        n = .Row - 1
        cc = .Value
    End With
    For i = 6 - n To UBound(cc)
        If IsDate(cc(i, 11)) Then
            ReDim Preserve Tft(ii)
            Tft(ii) = WorksheetFunction.Index(cc, i, 0)
            ii = ii + 1: lgS = lgS & ";" & i + n
        End If
    Next i
    With Worksheets("Temp")
        nT = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        .Range("A" & nT).Resize(ii, UBound(cc, 2)).Value = WorksheetFunction.Transpose( _
         WorksheetFunction.Transpose(Tft))
        .Activate
    End With
    lgS = Split(lgS, ";")
    With Worksheets("Base")
        For i = UBound(lgS) To 1 Step -1
            .Rows(lgS(i)).Delete
        Next i
    End With
End Sub

Ne pas laisser la Change antérieure active en même temps (ou alors interrompre les évènements dans la proc. ci-dessus).

Tu pourras la raccorder à un bouton, ou la lancer directement ou avec un raccourci clavier...

Cordialement.

Un grand merci pour ton aide.

J'utilise le lancement de la macro avec un raccourci clavier car avec un bouton ça ne fonctionne pas (message suivant : cette formule est trop compliquée pour être affectée à un objet). Mais tant que ça marche moi ça me va !

Merci

cette formule est trop compliquée pour être affectée à un objet

Tu rigoles là ! Comment as-tu fait ?

La voilà attachée à un bouton.

J'ai utilisé "bouton" depuis l'onglet "développeur" et "contrôle de formulaire"

En faisant un copier-coller dans un nouveau classeur excel ça fonctionne... bizarre , mais cool !

Merci beaucoup pour ton aide précieuse!