cherche formule pour mettre sur feuil1,2,3

[Sylvie64]

Bonjour,

J'aimerai mettre les communes des naissances en colonne A (rouge) sur la feuil (naissances) et mettre le noms des communes sur la page naissances par ordre alphabétique.
Ainsi que pour les mariages colonne B sur la feuil mariage et les décès colonne C sur la feuil décès

En Pj voir exemple. sur les feuil Naissances, Mariages, Décès (j'ai mis les communes par ordre alphabétique) se sont des exemples de ce que j'aimerai. (il y a 85010 lignes sur ma page Excel)

Maintenant savoir si cela est possible.

Merci pour votre aide

Sylvie

 

[Sylvie64]

Re : cherche formule pour mettre sur feuil1,2,3

Personne pour aider !!!!

Ou impossible à effectuer !!!

Merci

 

[mromain]

Re : cherche formule pour mettre sur feuil1,2,3

Bonjour Sylvie64,


Voici un essai :

Cette partie du code est à mettre dans ThisWorkbook :

Const nomsOnglets As String = "Naissances;Mariages;Décès"
Const colonneCorrespondante As String = "A;B;C"


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim tabF() As String, tabC() As String, i As Long
    tabF = Split(nomsOnglets, ";")
    tabC = Split(colonneCorrespondante, ";")
    For i = LBound(tabF) To UBound(tabF)
        If Sh.Name = tabF(i) Then RefreshData Sh, tabC(i)
    Next i
End Sub

Celle-là dans un nouveau module :

Public Sub RefreshData(feuille As Worksheet, colonne As String)
Dim mem1 As Long, mem2 As Long, mem3 As Long
    'mémoriser/désactiver les options d'excel
    mem1 = Application.Calculation: Application.Calculation = xlCalculationManual
    mem2 = Application.EnableEvents: Application.EnableEvents = False
    mem3 = Application.ScreenUpdating: Application.ScreenUpdating = False
    
    'exécuter la macro
    On Error Resume Next
     RefreshDataInt feuille, colonne
    On Error GoTo 0
    
    'rétablir les options d'excel
    Application.Calculation = mem1
    Application.EnableEvents = mem2
    Application.ScreenUpdating = mem3

End Sub


Private Sub RefreshDataInt(feuille As Worksheet, colonne As String)
Dim tabVal() As Variant, i As Long, j As Long, laCell As Range, tmp As Variant, ligneE As Long


    'effacer le contenu de la feuille
    feuille.Range("A1").CurrentRegion.Offset(1, 0).EntireRow.Clear
    
    ReDim tabVal(1 To 2, 1 To 1)
    ligneE = 1
    
    With ThisWorkbook.Sheets("Individus")
        'boucler sur toutes les données de la colonne A (Naissances) de la feuille Individus
        For Each laCell In .Range(colonne & "2:" & colonne & .Range(colonne & .Rows.Count).End(xlUp).Row)
            'si la cellule n'est pas vide
            If laCell.Text <> "" Then
                'redimensionner le tableau
                i = i + 1
                ReDim Preserve tabVal(1 To 2, 1 To i)
                'ajouter la valeur de la cellule ainsi que sa ligne au tableau
                tabVal(1, i) = laCell.Text
                tabVal(2, i) = laCell.Row
            End If
        Next laCell
        
        'trier alphabétiquement le tableau
        For i = LBound(tabVal, 2) To UBound(tabVal, 2) - 1
            For j = i + 1 To UBound(tabVal, 2)
                If tabVal(1, j) < tabVal(1, i) Then
                    tmp = tabVal(1, j)
                    tabVal(1, j) = tabVal(1, i)
                    tabVal(1, i) = tmp
                    tmp = tabVal(2, j)
                    tabVal(2, j) = tabVal(2, i)
                    tabVal(2, i) = tmp
                End If
            Next j
        Next i
        
        'boucler sur chaque élément du tableau et rapatrier les données sur la feuille
        For i = LBound(tabVal, 2) To UBound(tabVal, 2)
            ligneE = ligneE + 1
            feuille.Range("A" & ligneE).Value = tabVal(1, i)
            feuille.Range("B" & ligneE).Value = .Range("D" & tabVal(2, i)).Value
            feuille.Range("C" & ligneE).Value = .Range("E" & tabVal(2, i)).Value
            feuille.Range("D" & ligneE).Value = .Range("F" & tabVal(2, i)).Value
            feuille.Range("E" & ligneE).Value = .Range("G" & tabVal(2, i)).Value
            feuille.Range("F" & ligneE).Value = .Range("H" & tabVal(2, i)).Value
            feuille.Range("G" & ligneE).Value = .Range("I" & tabVal(2, i)).Value
            feuille.Range("H" & ligneE).Value = .Range("J" & tabVal(2, i)).Value
            feuille.Range("I" & ligneE).Value = .Range("K" & tabVal(2, i)).Value
            feuille.Range("J" & ligneE).Value = .Range("L" & tabVal(2, i)).Value
        Next i
    End With
End Sub

a+

 

[Sylvie64]

Re : cherche formule pour mettre sur feuil1,2,3

Bonsoir mromain,

Pour le deuxième pas de problème mais pour mettre dans ThisWorkbook, là j'ai un souci.
Je vous envoi la PJ mais les codes ne s'enregistre pas !!!

Merci de vous être pencher sur mon problème

Sylvie

 

[Sylvie64]

Re : cherche formule pour mettre sur feuil1,2,3

Merci pour tes codes mromain !!!
Je suis arrivé, avec un peu difficulté !!!
Excellent, merci pour ton aide
Sylvie