eviter la repetition si date identique

[sergio5862]

Bonjour a toutes a tous .

Dans un classeur de plusieurs onglets ,j'effectue un filtre sur des compteurs electriques toutes les heures et en fonction du resultat , j'ouvre un classeur excel existant et je recopie le resultat du batiment concerné par le filtre.Une boite de dialogue me demande de rentrer la date du jour et en fonction de la reponse ,je nomme l'onglet et je quitte en sauvegardant.Je renouvelle cette opération x fois en me basant sur le même principe pour les autres batiments.Comment faire pour que je n'ai plus besoin de rentrer la date du jour pour les suivants si identique au premier fichier .( J'ai un archivage des valeurs d'un mois ).J'utilise une USF pour lancer ma macro .

Merci de m'aider
Amicalement


Sub enr_cpt_a()

Dim message, Title, Default

On Error Resume Next

Windows("energie.xls").Activate
Sheets("compteurs_heure_bat_A").Select
Range("A1:Z32").Select
Selection.Copy
ChDir "C:\puissances_ht\suivi_compteurs"
Workbooks.Open FileName:="C:\puissances_ht\suivi_compteurs\cpt_a.xls"
Sheets.Add
Sheets("Feuil1").Select
Range("A1").Select
ActiveSheet.Paste
message = "Entrez le jour sous le format 01 pour le 1er du Mois"
Title = "enregistrement Onglet en fonction de la date"

Default = ""

enr_date = InputBox(message, Title, Default)


Sheets("Feuil1").Name = enr_date
Application.DisplayAlerts = False
Range("A1").Select
ActiveWorkbook.BreakLink Name:= _
"C:\puissances_ht\relevés hebdomadaire\energie.xls", Type:=xlExcelLinks
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

 

[kllmoon]

Re : eviter la repetition si date identique

Met ta valeur enr_date dans une cellule, rajoute une condition à ta formule avant le save. Vite fait en copier coller pour te donner une idée, travaille le code ça devrait fonctionner.

 If enr_date = Date Then ' ou If [A1].value = enr_date then
Sheets("Feuil1").Name = enr_date
Application.DisplayAlerts = False
Range("A1").Select
ActiveWorkbook.BreakLink Name:= _
"C:\puissances_ht\relevés hebdomadaire\energie.xls", Type:=xlExcelLinks
ActiveWorkbook.Save
ActiveWorkbook.Close
Else

enr_date = InputBox(message, Title, Default)
[A1].value = enr_date
Sheets("Feuil1").Name = enr_date
Application.DisplayAlerts = False
Range("A1").Select
ActiveWorkbook.BreakLink Name:= _
"C:\puissances_ht\relevés hebdomadaire\energie.xls", Type:=xlExcelLinks
ActiveWorkbook.Save
ActiveWorkbook.Close
Endif

 

[sergio5862]

Re : eviter la repetition si date identique

bonjour le Forum et particulierement a kllmoon,

merci pour la reponse rapide et qui me satisfait pleinement.

Amicalement
serge