1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36
| Sub Mise_a_jour()
Static wksfichier As Worksheet
Static wksimput As Worksheet
Static wkbsthpte As Workbook
Dim position As String
'desactivation de la mise à jour de l'affichage
'Application.ScreenUpdating = False
'desactivation des alertes à la fermeture des fichiers
Application.DisplayAlerts = False
Set wksfichier = Worksheets("Fichiers disponibles")
Set wksimput = Worksheets("Imputations")
Set wkbsthpte = Workbooks("Synthèse pointage.xlsm")
j = 3
wksimput.Range("C3:ZZ10000").ClearContents
For i = 4 To wksfichier.Range("A4").End(xlDown).Row
' Eclaircir le code avec l'ajout en with du workbook et worksheet
With Workbooks("Synthèse pointage.xlsm").Worksheets("Imputations")
'Ouverture et desactivation des alertes pour mise à jour des classeurs
Application.Workbooks.Open wksfichier.Cells(i, 1).Value, UpdateLinks:=0
'Recopie du nom de la personne
Cells(1, 1).Copy
.Cells(3, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Copie de la colonne de pointage de chaque personne
Range("D3:D400").Copy
.Cells(4, j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Désactivation des alertes à la fermeture
'fermeture du classeur
Workbooks(wkbsthpte.Worksheets("Fichiers disponibles").Cells(i, 2).Value).Close SaveChanges:=False
j = j + 1
End With
Next i |
Partager