Qui peut reduire l'ecriture suivante

Le 21/10/2024 à 15:09

Private Sub CommandButton1_Click() Application.ScreenUpdating = False Application.EnableEvents = False Dim presenceFile As String Dim wb As Workbook Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet Dim sourceFile As String Dim wsSource As Worksheet Dim i As Long, rowCounter1 As Long, rowCounter2 As Long Dim checkValue1 As String Dim checkValue2 As String Dim checkValue3 As String Dim checkValue4 As String Dim checkValue5 As String Dim checkValue As String Dim isChecked As Boolean ' Définir le chemin du fichier de présence presenceFile = "D:\OneDrive - ATFP\Administration\2025\etat de pointage\feuille de presence.xlsx" ' Ouvrir le classeur de présence On Error Resume Next Set wb = Workbooks.Open(presenceFile) On Error GoTo 0 ' Vérifier si le classeur a été ouvert correctement If wb Is Nothing Then MsgBox "Le fichier de présence n'a pas pu être ouvert." Exit Sub End If ' Définir les feuilles Set ws1 = wb.Sheets("1") Set ws2 = wb.Sheets("2") Set ws3 = wb.Sheets("3") Set ws4 = wb.Sheets("4") ' Définir la feuille source sourceFile = "D:\OneDrive - ATFP\Administration\2025\etat de pointage\emploi du temps.xlsx" Set wsSource = Workbooks.Open(sourceFile).Sheets("HEURES DU TRAVAIL") ' Effacer les anciennes données dans ws1, ws2, ws3, et ws4 ws1.range("B7:C30").ClearContents ws2.range("B7:C30").ClearContents ws3.range("B7:C30").ClearContents ws4.range("B7:C30").ClearContents ' Vérifier si CheckBox1 est cochée If CheckBox1.value Then ' Initialiser les variables ' Remplir les feuilles 1 et 2 en fonction des CheckBox rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 4).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 2).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 3).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 4).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 2).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 3).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 4).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 2).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 3).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 4).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 2).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 3).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 4).value = "Ýäí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 2).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 3).value rowCounter1 = rowCounter1 + 1 End If End If Next i ' Remplir les feuilles 2 rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 4).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 2).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 3).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 4).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 2).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 3).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 4).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 2).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 3).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 4).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 2).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 3).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 4).value = "Ýäí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 2).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 3).value rowCounter2 = rowCounter2 + 1 End If End If Next i ' Remplir les feuilles 3 et 4 de manière similaire rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 7).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 5).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 6).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 7).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 5).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 6).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 7).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 5).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 6).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 7).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 5).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 6).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 7).value = "Ýäí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 5).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 6).value rowCounter1 = rowCounter1 + 1 End If End If Next i rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 7).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 5).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 6).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 7).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 5).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 6).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 7).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 5).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 6).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 7).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 5).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 6).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 7).value = "Ýäí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 5).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 6).value rowCounter2 = rowCounter2 + 1 End If End If Next i End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Vérifier si CheckBox2 est cochée If CheckBox2.value Then ' Initialiser les variables ' Remplir les feuilles 1 et 2 en fonction des CheckBox rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 12).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 10).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 11).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 12).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 10).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 11).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 12).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 10).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 11).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 12).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 10).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 11).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 12).value = "Ýäí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 10).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 11).value rowCounter1 = rowCounter1 + 1 End If End If Next i ' Remplir les feuilles 2 rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 12).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 10).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 11).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 12).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 10).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 11).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 12).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 10).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 11).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 12).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 10).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 11).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 12).value = "Ýäí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 10).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 11).value rowCounter2 = rowCounter2 + 1 End If End If Next i ' Remplir les feuilles 3 et 4 de manière similaire rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 15).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 13).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 14).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 15).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 13).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 14).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 15).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 13).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 14).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 15).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 13).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 14).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 15).value = "Ýäí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 13).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 14).value rowCounter1 = rowCounter1 + 1 End If End If Next i rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 15).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 13).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 14).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 15).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 13).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 14).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 15).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 13).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 14).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 15).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 13).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 14).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 15).value = "Ýäí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 13).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 14).value rowCounter2 = rowCounter2 + 1 End If End If Next i End If '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Vérifier si CheckBox3 est cochée If CheckBox3.value Then ' Initialiser les variables ' Remplir les feuilles 1 et 2 en fonction des CheckBox rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 20).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 18).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 19).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 20).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 18).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 19).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 20).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 18).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 19).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 20).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 18).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 19).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 20).value = "Ýäí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 18).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 19).value rowCounter1 = rowCounter1 + 1 End If End If Next i ' Remplir les feuilles 2 rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 20).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 18).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 19).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 20).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 18).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 19).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 20).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 18).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 19).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 20).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 18).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 19).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 20).value = "Ýäí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 18).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 19).value rowCounter2 = rowCounter2 + 1 End If End If Next i ' Remplir les feuilles 3 et 4 de manière similaire rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 23).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 21).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 22).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 23).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 21).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 22).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 23).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 21).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 22).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 23).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 21).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 22).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 23).value = "Ýäí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 21).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 22).value rowCounter1 = rowCounter1 + 1 End If End If Next i rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 23).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 21).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 22).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 23).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 21).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 22).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 23).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 21).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 22).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 23).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 21).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 22).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 23).value = "Ýäí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 21).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 22).value rowCounter2 = rowCounter2 + 1 End If End If Next i End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Vérifier si CheckBox4 est cochée If CheckBox4.value Then ' Initialiser les variables ' Remplir les feuilles 1 et 2 en fonction des CheckBox rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 28).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 26).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 27).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 28).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 26).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 27).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 28).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 26).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 27).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 28).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 26).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 27).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 28).value = "Ýäí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 26).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 27).value rowCounter1 = rowCounter1 + 1 End If End If Next i ' Remplir les feuilles 2 rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 28).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 26).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 27).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 28).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 26).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 27).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 28).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 26).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 27).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 28).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 26).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 27).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 28).value = "Ýäí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 26).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 27).value rowCounter2 = rowCounter2 + 1 End If End If Next i ' Remplir les feuilles 3 et 4 de manière similaire rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 31).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 29).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 30).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 31).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 29).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 30).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 31).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 29).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 30).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 31).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 29).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 30).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 31).value = "Ýäí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 29).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 30).value rowCounter1 = rowCounter1 + 1 End If End If Next i rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 31).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 29).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 30).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 31).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 29).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 30).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 31).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 29).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 30).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 31).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 29).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 30).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 31).value = "Ýäí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 29).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 30).value rowCounter2 = rowCounter2 + 1 End If End If Next i End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Vérifier si CheckBox5 est cochée If CheckBox5.value Then ' Initialiser les variables ' Remplir les feuilles 1 et 2 en fonction des CheckBox rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 36).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 34).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 35).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 36).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 34).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 35).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 36).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 34).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 35).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 36).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 34).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 35).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 36).value = "Ýäí" Then If rowCounter1 <= 30 Then ws1.Cells(rowCounter1, 2).value = wsSource.Cells(i, 34).value ws1.Cells(rowCounter1, 3).value = wsSource.Cells(i, 35).value rowCounter1 = rowCounter1 + 1 End If End If Next i ' Remplir les feuilles 2 rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 36).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 34).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 35).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 36).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 34).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 35).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 36).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 34).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 35).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 36).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 34).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 35).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 36).value = "Ýäí" Then If rowCounter2 <= 30 Then ws2.Cells(rowCounter2, 2).value = wsSource.Cells(i, 34).value ws2.Cells(rowCounter2, 3).value = wsSource.Cells(i, 35).value rowCounter2 = rowCounter2 + 1 End If End If Next i ' Remplir les feuilles 3 et 4 de manière similaire rowCounter1 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 39).value = "ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 37).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 38).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 39).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 37).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 38).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 39).value = "ÅÏÇÑí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 37).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 38).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 39).value = "ÚãáÉ" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 37).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 38).value rowCounter1 = rowCounter1 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 39).value = "Ýäí" Then If rowCounter1 <= 30 Then ws3.Cells(rowCounter1, 2).value = wsSource.Cells(i, 37).value ws3.Cells(rowCounter1, 3).value = wsSource.Cells(i, 38).value rowCounter1 = rowCounter1 + 1 End If End If Next i rowCounter2 = 7 For i = 6 To 62 If CheckBox8.value And wsSource.Cells(i, 39).value = "ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 37).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 38).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox9.value And wsSource.Cells(i, 39).value = "ÔÈå ÈíÏÇÛæÌí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 37).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 38).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox10.value And wsSource.Cells(i, 39).value = "ÅÏÇÑí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 37).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 38).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox11.value And wsSource.Cells(i, 39).value = "ÚãáÉ" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 37).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 38).value rowCounter2 = rowCounter2 + 1 End If End If If CheckBox12.value And wsSource.Cells(i, 39).value = "Ýäí" Then If rowCounter2 <= 30 Then ws4.Cells(rowCounter2, 2).value = wsSource.Cells(i, 37).value ws4.Cells(rowCounter2, 3).value = wsSource.Cells(i, 38).value rowCounter2 = rowCounter2 + 1 End If End If Next i End If wsSource.Parent.Close SaveChanges:=False ' Fermer le classeur de présence wb.Close SaveChanges:=True Application.ScreenUpdating = True Application.EnableEvents = True MsgBox "Les données ont été copiées avec succès." End Sub

Le 21/10/2024 à 16:01

bonjour, c'est une blague ?

Le 21/10/2024 à 16:32

Bonjour à tous ,

S'il n'y a que ça pour vous faire plaisir, voila c'est réduit, concis, propre, lisible et c'est garanti sans erreur :

Private Sub CommandButton1_Click(): End Sub

Rechercher des sujets similaires à "qui reduire ecriture suivante"