Tableau récapitulatif

Tchi -  
Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   -
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
A voir également:

1 réponse

Zoul67 Messages postés 1959 Date d'inscription   Statut Membre Dernière intervention   149
 
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