coup de pouce simplification de macro

reivax95

XLDnaute Nouveau
bonjour à tous, et merci de l'aide que vous pourrez m'apporter.

Je dois créer un fichier de gestion d'une croix verte d'accident de travail sur 4 atelier.

Mon soucis est de simplifier une macro, en fait je repète toujours la même chose en fonction d'une date, ce qui fait que je repete ma formule 31 fois dans ma macro.

Je viens lire la date du jour, et fonction de cette date je copie des valeurs dans 2 cellules, mais comme je ne sais pas comment indexer ma macro en fonction de la date, j'ai repete la formule autant de fois qu'il y a de jour.

Le fichier est actualisé une fois par jour, pour les accidents de la veille et si c'est le lundi, il faut qu'il actualise sur les trois jours précédent, vendredi, samedi et dimanche, et là je suis bloqué également.

voici un extrait de la macro, le fichier est trop gros je ne peux pas le joindre.

Application.ScreenUpdating = False



For i = 2 To ActiveWorkbook.Worksheets.Count
Worksheets(i).Select
With ActiveWindow


If Range("AR3") - 1 = Range("AY3") Then

Range("AQ3").Select
Selection.Copy
Range("AU3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("AR5").Select
Selection.Copy
Range("AV3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("AR6").Select
Selection.Copy
Range("AZ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

End If


merci de votre aide
 

Pierrot93

XLDnaute Barbatruc
Re : coup de pouce simplification de macro

Bonjour à tous

Attention Jean-Marcel il manque un "end with" et le point est doublé... préférable d'utiliser les balises code à disposition....

une autre solution :

Code:
Option Explicit
Sub test()
Dim i As Byte
For i = 2 To Worksheets.Count
    With Sheets(i)
        If .Range("AR3").Value - 1 = .Range("AY3").Value Then
            .Range("AU3").Value = .Range("AQ3").Value
            .Range("AV3").Value = .Range("AR5").Value
            .Range("AZ3").Value = .Range("AR6").Value
        End If
    End With
Next i
End Sub

bonne journée
@+
 
Dernière édition:

reivax95

XLDnaute Nouveau
Re : coup de pouce simplification de macro

merci de vos explications,

mais ce n'est qu'un extrait de la macro, je la repete 31 fois et à chaque fois j'incremente de 1 les cellules AU AV et AZ en copiant toujours les mêmes cellules dedans .

Soit pour la première ("AU3") ("AV3") et ("AZ3")
("AU4") ("AV4") et ("AZ4") pour la seconde et ainsi de suite jusqu'a
("AU33") ("AV33") et ("AZ33")
 

Pierrot93

XLDnaute Barbatruc
Re : coup de pouce simplification de macro

Re

comme le disait précédemment Jean-Marcel, un petit fichier avec modèle de donnée et résultat attendu nous permettrait de t'aider beaucoup plus facilement....

@+

Edition : aarf, un peu en retard moi... Merci Jean-Marcel pour les balises.... c'est quand même plus lisible.
 

reivax95

XLDnaute Nouveau
Re : coup de pouce simplification de macro

merci de vos reponses, mais mon fichier etant trop gros, 233ko, même zipper 86ko, je ne peux pas le mettre en pièce jointe, à moins que vous ayez une astuce. :eek:

Jean-marcel ta macro fonctionne apres qque modif

voici le resultat

Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 22/12/2009 par
'


Application.ScreenUpdating = False


'Option Explicit
'Sub test()
Dim i As Byte
Dim J As Byte
For i = 2 To Worksheets.Count
With Sheets(i)
For J = 1 To 31
If .Range("AR3").Value - 1 = .Range("AY" & 2 + J).Value Then
.Range("AU" & 2 + J).Value = .Range("AQ3").Value
.Range("AV" & 2 + J).Value = .Range("AR5").Value
.Range("AZ" & 2 + J).Value = .Range("AR6").Value
End If
Next
End With
Next i
'End Sub

Sheets("SAISIE").Select

Range("A1").Select

End Sub

un grand merci.

il me reste à trouver comment gerer les week-end.
 

Discussions similaires

Réponses
2
Affichages
180
Réponses
5
Affichages
211
Réponses
3
Affichages
285

Statistiques des forums

Discussions
312 775
Messages
2 092 003
Membres
105 145
dernier inscrit
juliendauba1