Doublons de dates

[MISTERJUNGLE]

BONJOUR LE FORUM,
J'ai un souci avec une une formule VBA
Dans mon fichier joint ce trouve une feuille nommee "FORMULAIRE" qui me permet de renvoyer sur la feuille nommee "ALAIN" des heures,la formule fonctionne ,mais lorque la date du formulaire existe deja dans la feuile "Alain" je voudrait quelle la remplace
alors que la elle me la rajoute

Sub Valider()

Sheets("ALAIN").Select
Range("A4:H8359").Select

Range("A4").Select
Dim rng As Range, c As Range, ws As Worksheet, dl As Long
Application.ScreenUpdating = False
Dim nomfeuil As String
With Sheets("FORMULAIRE")
Set rng = .Range("A4:A" & .Range("A65000").End(xlUp).Row)
For Each c In rng
If c <> "" Then
On Error Resume Next
Set ws = Sheets(CStr(c))
On Error GoTo 0
If Not ws Is Nothing Then
With ws
dl = .Range("A65000").End(xlUp).Row + 1
.Range("A" & dl).Resize(1, 8).Value = c.Offset(, 1).Resize(1, 8).Value

End With
End If
Set ws = Nothing
End If
Next
End With
Application.ScreenUpdating = True

End Sub


merci pour votre aide

 

[phlaurent55]

Re : Doublons de dates

Bonjour Misterjungle,

dans ta seconde ligne de code remplace
Range("A4:H8359").Select
par
Range("A4:H8359").ClearContents

à+
Philippe

 

[MISTERJUNGLE]

Re : Doublons de dates

Bonjour phlaurent55,

Et tout d'abord merci ,mais si je remplace "Range("A4:H8359").Select" par "Range("A4:H8359").ClearContents
il efface toutes les dates de la feuille,alors qu'il faut uniquement effacer et remplacer la ligne qui contient la meme date que le formulaire
A te relire merci

 

[laetitia90]

Re : Doublons de dates

bonjour mister jungle , laurent
a mon avis le plus simple on copy a la suite sur la feuille alain sur la feuille alain on traite les doublons en partant du bas (important)
puis on trie la plage en ordre croissant en partant de la colonne a
pas le temps de regarder

 

[MISTERJUNGLE]

Re : Doublons de dates

Bonjour laetitia90,
merci de ton approche ,mais je pense qu'avec excel il est possible qu'il reconnaisse la date,l'efface et la remplace par celle du "formulaire"
je sais c'est facile a dire mais pas facile a trouver dans mon cas
il me manque juste ce morceau de code...

 

[Robert]

Re : Doublons de dates

Bonsoir le fil, bonsoir le forum,

Peut-ête comme ça :

Sub Valider()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim o As Worksheet 'déclare la variable o (Onglet)
Dim dt As Date 'déclare la variable dt (DaTe)
Dim r As Range 'déclare la variable r (Recherche)
Dim dest As Range 'déclare la variable dest (DESTInation)
 
''Sheets("ALAIN").Select
''Range("A4:H8359").Select
''Range("A4").Select
 
Application.ScreenUpdating = False 'masque les changements à l'écran
Set pl = Sheets("FORMULAIRE").Range("A4:A" & Sheets("FORMULAIRE").Range("A65536").End(xlUp).Row) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules éditées cel de la plage pl
    If cel.Value <> "" Then 'condition 1 : si la cellule n'est pas vide
        On Error Resume Next 'en cas d'erreur passe à la ligne suivante
        Set o = Sheets(CStr(cel.Value)) 'définit l'onglet o (génère une erreur si l'onglet n'existe pas)
        On Error GoTo 0 'annule la gestion des erreurs
        If Not o Is Nothing Then 'condition 2 : si l'onglet o existe
            'définit la recherche r (recherche la date en B de cel dans la colonne A de l'onglet o)
            dt = cel.Offset(0, 1).Value 'définit la date dt
            Set r = o.Columns(1).Find(dt, , xlFormulas, xlWhole) 'définit la recherche r
            If Not r Is Nothing Then 'condition 3 : si la date existe
                Set dest = r 'définit la cellule de destination (cellule de la date trouvée)
            Else 'sinon
                'définit la cellule de destination (première cellule vide rencontrée)
                Set dest = o.Range("A65536").End(xlUp).Offset(1, 0)
            End If 'fin de la condition 3
            Range(cel.Offset(0, 1), cel.Offset(0, 7)).Copy dest 'copie les données dans dest
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next cel 'prochaine cellule cel de la boucle
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

 

[MISTERJUNGLE]

Re : Doublons de dates

Re_le forum
UN GRAND MERCI "Robert" c fantastique,elle est geniale ta macro
un petit detail lors de la saisie sur la feuille de "ALAIN" la taille de l'ecriture est de "14" , un peu trop grosse comment puis je faire
pour la faire passer a "10"
MERCI

 

[Robert]

Re : Doublons de dates

Bonsoir le fil, bonsoir le forum,

Rajoute cette ligne :

Range(dest, dest.Offset(0, 7)).Font.Size = 10 'police taille 10 pour les données copiées

en dessous de la ligne :

Range(cel.Offset(0, 1), cel.Offset(0, 7)).Copy dest 'copie les données dans dest

dans le code que je t'ai donné.

 

[MISTERJUNGLE]

Re : Doublons de dates

RE_le forum

Robert que dire apres cette petite merveille qui va me faire avancer
UN GRAND GRAND MERCI.........