Tableau récapitulatif

Fermé
Tchi - 9 août 2021 à 13:40
Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 - 10 août 2021 à 17:39
Bonjour,

Je souhaite faire un tableau récapitulatif de plusieurs cellules sur différentes feuilles. Le code en question a été résolu cependant j'aimerai que lorsque je clique sur le bouton, les étapes suivantes se fasses:
1. Déverrouiller la feuille (mot de passe ".")
2. Vider les cellules A3:E1000
3. Récupération des cellules sur différentes feuilles (ok)
4. Reverrouillage de la feuille (mot de passe ".")

Voici le code que j'ai actuellement qui ne fonctionne pas:

Option Explicit

Private Sub CommandButton6Click()

'Déverrouiller la feuille
ActiveSheet.Unprotect Password:="."
'Vider les cellules
Sheets("Résumé").Range("A3:E1000").ClearContents

End Sub


Sub synthese()
Dim nbSheets As Integer, i As Long, j As Long, compt As Long
Dim nL1 As Long, nL2 As Long
Dim wS1 As Worksheet, wS2 As Worksheet

Set wS1 = Sheets("Résumé")
nbSheets = Sheets.Count

compt = 2
For i = 1 To Sheets.Count
nL1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
' On ne prend pas en compte les feuilles non utilisées
If Sheets(i).Name <> "Données" And Sheets(i).Name <> "Inspection machine" And Sheets(i).Name <> "Résumé" And Sheets(i).Name <> "Feuil1" Then
Set wS2 = Sheets(i)
nL2 = lastRow(Sheets(i), 2)
If nL2 > 2 Then
For j = 3 To nL2
If wS2.Cells(j, 3).Value = "Incorrect" Then
compt = compt + 1
wS1.Cells(compt, 1) = compt - 2
wS1.Cells(compt, 2) = wS2.Range("B1")
wS1.Cells(compt, 3) = wS2.Range("A" & j)
wS1.Cells(compt, 4) = wS2.Range("B" & j)
wS1.Cells(compt, 5) = wS2.Range("D" & j)
End If
Next j
End If
End If
Next i
wS1.Activate
MsgBox compt - 2 & " anomalies constatées.", vbInformation + vbOKOnly, "Anomalies"
'Reverrouiller la feuille
ActiveSheet.Protect Password:="."
End Sub

Function lastRow(ws As Worksheet, c As Integer)
Dim i As Long, nL As Long

ws.Activate

nL = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 3 To nL
If Trim(ws.Cells(i, c)) = "" Then
lastRow = i - 1
Exit For
End If
Next i
End Function

D'avance merci pour votre aide et meilleures salutations,

Thierry

1 réponse

Zoul67 Messages postés 1959 Date d'inscription lundi 3 mai 2010 Statut Membre Dernière intervention 30 janvier 2023 149
10 août 2021 à 17:39
Bonjour,

Ta fonction lastrow est bizarre (mais dépend des données susceptibles de se trouver dans les feuilles). En admettant qu'elle soit bonne, il faudrait un "_" dans le nom de la procédure que j'ai complétée :
Private Sub CommandButton1_Click()
'Déverrouiller la feuille
ActiveSheet.Unprotect Password:="."
'Vider les cellules
Sheets("Résumé").Range("A3:E1000").ClearContents
Call synthese
'Reverrouiller la feuille
ActiveSheet.Protect Password:="."
End Sub


A+
0