Microsoft 365 Trouver la dernière ligne de tous les onglets par VBA

[Roseline]

Bonjour,
Je vous explique le fonctionnement de mon fichier.
Dans chacun de mes onglets, lorsque j'inscrit une information dans la colonne A, la date du jour s'inscrit automatiquement dans la colonne B. J'aimerais qu'à la fermeture de mon fichier, toutes les nouvelles données et les données antérieures soient transformées en valeur afin de faire disparaitre la formule "aujourdhui" dans ma colonne B pour ne pas que ma date se change à la prochaine ouverture du fichier.
J'ai joint un fichier avec une partie de ma programmation.
Merci de votre aide encore une fois.

 

[sylvanu]

Bonsoir Roseline,
Un essai en PJ avec :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
     For Each F In Worksheets
        With Sheets(F.Name)
            DL = .Cells(Cells.Rows.Count, "B").End(xlUp).Row
            .Range("B1:B" & DL) = .Range("B1:B" & DL).Value
        End With
     Next F
     ActiveWorkbook.Save
End Sub

En quittant il enregistre le fichier.

 

[job75]

Bonsoir,

Il faut conserver les formules qui renvoient le texte vide "" donc :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w As Worksheet, c As Range
    On Error Resume Next
    For Each w In Worksheets
        For Each c In w.Columns(2).SpecialCells(xlCellTypeFormulas, 1) 'formule renvoyant un nombre
            c = c.Value 'supprime la formule
    Next c, w
    Me.Save
End Sub

Bonne nuit.

 

[sylvanu]

Bonjour Roseline, Job,

Il faut conserver les formules qui renvoient le texte vide

Oups! J'ai raté ça.
Alors un autre essai. Les formules en B sont inutiles, si une macro remplit les colonnes B.
Dès qu'on met une valeur en A la cellule en B prend la valeur de la date, et si on efface une cellule en A, la cellule en B s'efface.
C'est automatique sur toutes les feuilles.

Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A:A]) Is Nothing Then
        If Target = "" Then                 ' Si cellule A vide ou vidée
            Cells(Target.Row, "B") = ""     ' On efface B
        Else
            Cells(Target.Row, "B") = Date   ' Sinon on met la date
        End If
    End If
Fin:
End Sub

 

[job75]

Bonjour Roseline, sylvanu,

Les entrées/effacements peuvent concerner plusieurs cellules, utilisez plutôt :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Set Target = Intersect(Target, Sh.[A:A], Sh.UsedRange)
    If Target Is Nothing Then Exit Sub
    With Intersect(Target.EntireRow, Sh.[B:B])
        .FormulaR1C1 = "=IF(RC[-1]="""","""",TODAY())"
        With Sh.Range(Replace(.Address, ",", ":"))
            .Value = .Value 'supprime les formules
        End With
    End With
End Sub

A+