XL 2010 Code VBA à simplifier et/ou corriger

[LAPIN-53]

Bonjour,
Je débute en VBA et j'ai un souci sur un code créé. Je suis passé par l'enregistreur de macro et le code doit être trop lourd car interminable et je pense qu'il ya également un bug.
En fait j'ai un fichier de pointage, dans la colonne C j'ai le numéro d'identification du salarié, en D le nom, en E le prénom, en F la date, en G l'heure, en H les minutes.
J'ai 4 pointage par jour et par salarié (arrivée matin - départ matin - arrivée apm- départ apm)
Je souhaite créer une macro qui reconstitue sur 1 ligne l'heure d'arrivée du matin et de l'apm et l'heure de départ du matin et de l'apm par jour et par agent.
Sachant que le nombre de ligne est indéterminée.
J'ai créé ce code :
Sub MaJ()
' MaJ Macro
Application.ScreenUpdating = False
Sheets("Report données").Select
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A10000")
Range("A3:A100000").Select
Range("J3").Select
Selection.AutoFill Destination:=Range("J3:J100000")
Sheets("Détail pointage").Select
Range("D5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C4,RC[-3],RC[-2]),'Report données'!R5C1:R100000C10,10,FALSE)"
Range("D6").Select
Sheets("Détail pointage").Select
Range("D5").Select
Selection.AutoFill Destination:=Range("D5100000")
Range("D5100000").Select
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C5,RC[-4],RC[-3]),'Report données'!R5C1:R100000C10,10,FALSE)"
Range("E6").Select
Sheets("Détail pointage").Select
Range("E5").Select
Selection.AutoFill Destination:=Range("E5:E100000")
Range("E5:E100000").Select
Range("F5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C6,RC[-5],RC[-4]),'Report données'!R5C1:R100000C10,10,FALSE)"
Range("F6").Select
Sheets("Détail pointage").Select
Range("F5").Select
Selection.AutoFill Destination:=Range("F5:F100000")
Range("F5:F100000").Select
Range("G5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C7,RC[-6],RC[-5]),'Report données'!R3C1:R100000C10,10,FALSE)"
Range("G5").Select
Selection.AutoFill Destination:=Range("G5:G100000")
Range("G5:G100000").Select
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:C100000")
Range("C4:C100000").Select
Range("I4").Select
Selection.AutoFill Destination:=Range("I4:I100000")
Range("I4:I100000").Select
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J100000")
Range("J4:J100000").Select
ActiveSheet.Range("$A$4:$V$100000").AutoFilter Field:=10, Criteria1:="#N/A"
Range("J5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.Range("$A$4:$V$100000").AutoFilter Field:=10
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K100000")
Range("K4:K100000").Select
MsgBox ("Mise à jour, OK !")
End Sub


Mais celui-ci mouline, soit bug soit trop long à exécuter, qqn peut-il m'aider s'il vous plait.

 

[fanfan38]

Bonjour
Un fichier est toujours le bienvenu
ci joint une proposition..
A+ François

 

[LAPIN-53]

Mon fichier était trop volumineux. Je l'ai donc allégé en ne laissant les données que pour 1 salarié sur 1 mois. J'ai également effacer le code VBA du module 1 qui est logiquement relié au bouton mise à jour et il faudra faire défiler jusqu'en bas la formule de la cellule J3 (en jaune)
Il suffirait de refaire un copier coller de mon code pour voir comment le fichier fonctionne.
A savoir que le nombre de ligne de mon fichier est inconnu car fonction du nombre de salarié et du nombre de pointage (généralement 4 mais parfois plus) par jour sur 1 an.

Merci beaucoup pour l'aide que vous pourrez m'apporter.

Code à copier :
Sub MaJ()

' MaJ Macro
Application.ScreenUpdating = False
Sheets("Report données").Select
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A10000")
Range("A3:A100000").Select
Range("J3").Select
Selection.AutoFill Destination:=Range("J3:J100000")
Sheets("Détail pointage").Select
Range("D5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C4,RC[-3],RC[-2]),'Report données'!R5C1:R100000C10,10,FALSE)"
Range("D6").Select
Sheets("Détail pointage").Select
Range("D5").Select
Selection.AutoFill Destination:=Range("D5100000")
Range("D5100000").Select
Range("E5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C5,RC[-4],RC[-3]),'Report données'!R5C1:R100000C10,10,FALSE)"
Range("E6").Select
Sheets("Détail pointage").Select
Range("E5").Select
Selection.AutoFill Destination:=Range("E5:E100000")
Range("E5:E100000").Select
Range("F5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C6,RC[-5],RC[-4]),'Report données'!R5C1:R100000C10,10,FALSE)"
Range("F6").Select
Sheets("Détail pointage").Select
Range("F5").Select
Selection.AutoFill Destination:=Range("F5:F100000")
Range("F5:F100000").Select
Range("G5").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(CONCATENATE(R2C7,RC[-6],RC[-5]),'Report données'!R3C1:R100000C10,10,FALSE)"
Range("G5").Select
Selection.AutoFill Destination:=Range("G5:G100000")
Range("G5:G100000").Select
Range("C4").Select
Selection.AutoFill Destination:=Range("C4:C100000")
Range("C4:C100000").Select
Range("I4").Select
Selection.AutoFill Destination:=Range("I4:I100000")
Range("I4:I100000").Select
Range("J4").Select
Selection.AutoFill Destination:=Range("J4:J100000")
Range("J4:J100000").Select
ActiveSheet.Range("$A$4:$V$100000").AutoFilter Field:=10, Criteria1:="#N/A"
Range("J5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.Range("$A$4:$V$100000").AutoFilter Field:=10
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K100000")
Range("K4:K100000").Select
MsgBox ("Mise à jour, OK !")
End Sub

 

[fanfan38]

Que pense tu de ma proposition?
A+ François

 

[LAPIN-53]

Bonjour,
Non, votre proposition ne correspond pas à mon attente.
En fait moi je récupère les données de pointage via des requêtes, nous avons environs 300 salariés avec au minimum 4 pointage par jour.
Sur une année, il y a donc environs 300 000 données à traiter donc les taper une par une dans le formulaire ca n'est pas possible.

 

[fanfan38]

Si j'ai bien compris les données arrivent dans report données et tu veux les mettre dans détails pointage
A+ François

 

[fanfan38]

Bonjour
Ma solution
A+ François

 

[LAPIN-53]

Bonjour merci pour votre aide, mais il va falloir que je trouve une autre solution. Soit mon fichier est trop lourd, soit mon pc n'est pas assez puissant. Quand je lance la macro ca mouline et ca finit en erreur.
Merci quand meme d'avoir consacré du temps pour m'aider. Bonne journée