Tableau récapitulatif
Tchi
-
Zoul67 Messages postés 1959 Date d'inscription Statut Membre Dernière intervention -
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
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:
- Tableau récapitulatif
- Tableau word - Guide
- Tableau ascii - Guide
- Trier un tableau excel - Guide
- Tableau croisé dynamique - Guide
- Imprimer tableau excel sur une page - Guide
1 réponse
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 :
A+
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+