Bonjour à tous,
Sur une feuille de calcul pour gérer une association, j’ai une colonne avec des cases à cocher « K » qui est lié avec la colonne « L » ou apparait une « coche » ou un « x » suivant que la cotisation est payée ou pas. Avec une macro VBA, je veux créer une feuille « Liste à imprimer » qui doit me ressortir uniquement le résultat des coches « payées », et éventuellement faire une mise à jour si une nouvelle coche est activée. Le programme ci-joint fonctionne si le feuille « Liste à imprimer » n’existe pas, elle est crée et remplie avec les données. Si elle existe il efface bien la feuille, mais elle reste vierge sans aucune donnée, alors je demande l’aide des spécialistes.
Sub ImprimerListeCoches()
Dim ws As Worksheet
Dim cell As Range
Dim newSheet As Worksheet
Dim rowNum As Integer
Dim cellValue As Variant
' Définir la feuille de calcul active
Set ws = ActiveSheet
' Vérifier si la feuille "Liste à Imprimer" existe déjà
On Error Resume Next
Set newSheet = Sheets("Liste à Imprimer")
On Error GoTo 0
' Si la feuille n'existe pas, la créer
If newSheet Is Nothing Then
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
newSheet.Name = "Liste à Imprimer"
Else
' Si la feuille existe, effacer les anciennes entrées
'newSheet.Cells.Clear
End If
' Initialiser le numéro de ligne pour la nouvelle feuille
rowNum = 1
' Parcourir chaque cellule de la colonne L
For Each cell In ws.Range("L2:L" & ws.Cells(ws.Rows.Count, "L").End(xlUp).Row)
' Vérifier la valeur de la cellule
cellValue = cell.Value
' Vérifier si la cellule est cochée
If cellValue = True Then
' Copier les valeurs des colonnes B, C, D et E à la nouvelle feuille
newSheet.Cells(rowNum, 1).Value = cell.Offset(0, -10).Value ' Colonne B
newSheet.Cells(rowNum, 2).Value = cell.Offset(0, -9).Value ' Colonne C
newSheet.Cells(rowNum, 3).Value = cell.Offset(0, -8).Value ' Colonne D
newSheet.Cells(rowNum, 4).Value = cell.Offset(0, -7).Value ' Colonne E
rowNum = rowNum + 1
End If
Next cell
' Message de débogage
MsgBox "Mise à jour terminée. Nombre de lignes ajoutées : " & rowNum - 1
End Sub
Sur une feuille de calcul pour gérer une association, j’ai une colonne avec des cases à cocher « K » qui est lié avec la colonne « L » ou apparait une « coche » ou un « x » suivant que la cotisation est payée ou pas. Avec une macro VBA, je veux créer une feuille « Liste à imprimer » qui doit me ressortir uniquement le résultat des coches « payées », et éventuellement faire une mise à jour si une nouvelle coche est activée. Le programme ci-joint fonctionne si le feuille « Liste à imprimer » n’existe pas, elle est crée et remplie avec les données. Si elle existe il efface bien la feuille, mais elle reste vierge sans aucune donnée, alors je demande l’aide des spécialistes.
Sub ImprimerListeCoches()
Dim ws As Worksheet
Dim cell As Range
Dim newSheet As Worksheet
Dim rowNum As Integer
Dim cellValue As Variant
' Définir la feuille de calcul active
Set ws = ActiveSheet
' Vérifier si la feuille "Liste à Imprimer" existe déjà
On Error Resume Next
Set newSheet = Sheets("Liste à Imprimer")
On Error GoTo 0
' Si la feuille n'existe pas, la créer
If newSheet Is Nothing Then
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
newSheet.Name = "Liste à Imprimer"
Else
' Si la feuille existe, effacer les anciennes entrées
'newSheet.Cells.Clear
End If
' Initialiser le numéro de ligne pour la nouvelle feuille
rowNum = 1
' Parcourir chaque cellule de la colonne L
For Each cell In ws.Range("L2:L" & ws.Cells(ws.Rows.Count, "L").End(xlUp).Row)
' Vérifier la valeur de la cellule
cellValue = cell.Value
' Vérifier si la cellule est cochée
If cellValue = True Then
' Copier les valeurs des colonnes B, C, D et E à la nouvelle feuille
newSheet.Cells(rowNum, 1).Value = cell.Offset(0, -10).Value ' Colonne B
newSheet.Cells(rowNum, 2).Value = cell.Offset(0, -9).Value ' Colonne C
newSheet.Cells(rowNum, 3).Value = cell.Offset(0, -8).Value ' Colonne D
newSheet.Cells(rowNum, 4).Value = cell.Offset(0, -7).Value ' Colonne E
rowNum = rowNum + 1
End If
Next cell
' Message de débogage
MsgBox "Mise à jour terminée. Nombre de lignes ajoutées : " & rowNum - 1
End Sub
