Macro cumul

Bonjour,

Comment faire pour avoir dans la feuille cumul la liste des collectivités avec celles qui sont enregistrées dans la feuille CSE, une coche dans la colonne CSE, celles qui sont enregistrées dans MP Comptes une coche dans la colonne MP Comptes , celles qui sont enregistrées dans STELA Comptes une coche dans la colonne STELA Comptes de la feuille Cumul?

Par avance merci de votre aide

21dsi.xlsx (37.46 Ko)

Salut Vs, Salut le Forum,

Tu trouveras ci-joint ton fichier modifié avec une macro qui, je l'espère, va résoudre ta demande !

La procédure agis comme ci-dessous :

  • Copie toute tes collectivités indiquées dans tes feuilles CSE ; MS Comptes et STELA Comptes et les colles dans ta feuilles Cumul
  • Supprime les doublons de ta feuilles Cumul
  • Recherche dans tes onglets si la collectivités est présente et coche si oui
  • Remet le tableau en forme

Ci-dessous le code pour ceux que sa intéresse :

Sub Recherche()
Dim OA As String, Onglet As String, VC As String
Dim x As Long, y As Long, a As Long, b As Long
Dim CVC As Range, R As Range
Dim O As Worksheet
x = Range("A" & Rows.Count).End(xlUp).Row
If x <> 1 Then
    Rows("2:" & x).Delete Shift:=xlUp
End If
a = Worksheets.Count
For b = 1 To a
    If Sheets(b).Name = "CSE" Or Sheets(b).Name = "MP Comptes" Or Sheets(b).Name = "STELA Comptes" Then
        Sheets(b).Select
        Range(Cells(2, 1), Cells(Range("A" & Rows.Count).End(xlUp).Row, 1)).Copy
        Sheets("Cumul").Select
        x = Range("A" & Rows.Count).End(xlUp).Row + 1
        Cells(x, 1).Select
        ActiveSheet.Paste
    End If
Next
x = Range("A" & Rows.Count).End(xlUp).Row
Columns("A:D").Select
ActiveSheet.Range("$A$1:$D$" & x).RemoveDuplicates Columns:=1, Header:=xlYes
Columns(1).Interior.Pattern = xlNone
Columns(1).Borders(xlInsideVertical).LineStyle = xlNone
Columns(1).Borders(xlInsideHorizontal).LineStyle = xlNone
Columns(1).Borders(xlEdgeRight).LineStyle = xlNone
x = Range("A" & Rows.Count).End(xlUp).Row
For y = 2 To x
    Set CVC = Cells(y, 1)
    VC = CVC.Value
    OA = ActiveSheet.Name
    For Each O In Sheets
        If Not O.Name = OA Then
            Set R = O.Cells.Find(VC, , xlValues, xlWhole)
            If Not R Is Nothing Then
                Onglet = O.Name
                If Onglet = "CSE" Then
                    Sheets("Cumul").Cells(y, 2) = "X"
                    ElseIf Onglet = "MP Comptes" Then Sheets("Cumul").Cells(y, 3) = "X"
                    ElseIf Onglet = "STELA Comptes" Then Sheets("Cumul").Cells(y, 4) = "X"
                End If
            End If
        End If
    Next
Next
Cells.WrapText = False
Cells.HorizontalAlignment = xlCenter
Cells.EntireColumn.AutoFit
Range("A1:D" & x).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A1:D" & x).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A1:D" & x).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A1:D" & x).Borders(xlInsideHorizontal).LineStyle = xlContinuous
Cells(1, 1).Select
End Sub

Tu a juste besoin de cliquer sur le bouton "Lancer ma recherche" dans la feuille Cumul

Restant à dispo

27pour-vs86963.xlsm (52.32 Ko)
Rechercher des sujets similaires à "macro cumul"