Historique spécial

Résolu/Fermé
vbaforlife - Modifié par pijaku le 27/07/2016 à 10:41
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 27 juil. 2016 à 10:41
Bonjour,
Je travaille sur un fichier (je ne sais pas mettre le lien du fichier excel sur ce message au passage) qui consiste à mettre à jour un tableau. J'ai la macro qui permet de mettre à jour le tableau :



Dim h_ppt As Date
u = 11

Range("B1:B50").Select
    Selection.Replace What:="H", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Range(Cells(u, 2), Cells(7 + u, 5)).Select
    Selection.NumberFormat = "hh:mm;@"
For jour = 1 To 7
i = 1
j = 2
L = Len(Cells(jour, 2))
While i < L
    If Asc(Mid(Cells(jour, 2), i, 1)) >= 48 And Asc(Mid(Cells(jour, 2), i, 1)) <= 57 Then
    h_txt = Mid(Cells(jour, 2), i, 4)
    h_utc = Left(h_txt, 2) & ":" & Right(h_txt, 2)
    Cells(jour + u, j) = h_utc
    i = i + 4
    j = j + 1
    Else
    i = i + 1
    End If
Wend
Next

For jour = 1 To 7
Cells(jour + 3 * u, 3) = Cells(jour + u * 2, 2)
If Cells(jour + u * 2, 4) = "-" Then
    Cells(jour + 3 * u, 2) = Cells(jour + u * 2, 3)
Else
    Cells(jour + 3 * u, 2) = Cells(jour + u * 2, 5)
    Cells(jour + 3 * u, 4) = Cells(jour + u * 2, 3)
    Cells(jour + 3 * u, 5) = Cells(jour + u * 2, 4)
End If
Next 





Seulement j'aimerais faire une deuxième macro qui me permet de répertorier sur une autre feuille, la date de la mise à jour de mon tableau. En gros une macro qui marque la date sur une autre feuille à chaque fois que la macro ci-dessus s'execute.

Merci de vos réponses futures.
A voir également:

1 réponse

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 751
27 juil. 2016 à 10:41
Bonjour,

Pour placer les dates en Feuil4, colonne A par exemple, ajouter en fin de votre macro les lignes :

Dim DL As Long
With Sheets("Feuil4")
   On Error Goto PremiereLigne
   DL = .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1 
   .Cells(DL, 1) = Date
End With 
Exit Sub
PremiereLigne:
With Sheets("Feuil4")
   .Cells(1, 1) = Date
End With
0