XL 2010 VENTILER DES DONNÉES SUR PLUSIEURS FEUILLE

[dreamso]

Bonjour tous le monde,

j'aimerai ventiler des donner sur plusieurs feuilles par numéro de compte avec la forme de début répétitive sur toutes les feuilles.

Merci pour votre aide.

 

[vgendron]

Bonjour

Sans plus de précisions sur ce que tu souhaites faire
voici un code

Sub Macro1()
Dim TabIni()  As Variant '==> on déclare un tableau
Set ListeComptes = CreateObject("Scripting.dictionary") 'on déclare un dictionaire


Application.ScreenUpdating = False 'on empeche le rafraichissemnt des feuilles


Set ActShe = ActiveSheet 'on enregistre la feuille active
With ActShe 'avec la feuille active
    Fin = .Range("A" & .Rows.Count).End(xlUp).Row 'on récupère la dernière ligne NON vide de la colonne A
    Set ZoneAFiltrer = .Range("A8:D" & Fin) 'on enregistre la zone à filtrer
    TabIni = .Range("A9:D" & Fin).Value 'on enregistre toutes les données dans le tableau vba
    For i = LBound(TabIni, 1) To UBound(TabIni, 1) 'pour chaque élémenent de la colonne A du tableau
        If Not ListeComptes.exists(TabIni(i, 1)) Then 'si le compte n'existe pas dans le dictionaire, on le crée
            ListeComptes.Add TabIni(i, 1), i
        End If
    Next i
    'ici, on a un dictionaire qui contien tous les numéros de comptes SANS doublon
End With
   
    For Each compte In ListeComptes.keys 'pour chaque compte
        Sheets.Add.Name = compte 'on crée une feuille du nom du compte
        ActShe.Activate 'on repasse sur la feuille Init
        Range("A1:D7").Copy Destination:=Sheets("" & compte & "").Range("A1") 'on copie l'entete

        ZoneAFiltrer.AutoFilter field:=1, Criteria1:=compte 'on filtre les données sur le numéro de compte
        ZoneAFiltrer.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("" & compte & "").Range("A8") 'on copie toutes les lignes filtrées
    Next compte
Application.ScreenUpdating = True 'on réactive le rafraichissement

End Sub

Note: vu le nombre important de comptes, l'execution dure quelques 20 à 30 s

 

[JHA]

Bonjour à tous,
Bonjour Vgendron

Ventilation manuelle par TCD

JHA

 

[job75]

Bonsoir dreamso, vgendron, JHA,

Créer autant de feuilles que de comptes est une énormité.

En effet il suffit de filtrer la feuille sur le numéro de compte que l'on veut.

Recherche intuitive avec une ComboBox :

Private Sub ComboBox1_Change()
Dim P As Range, x$, tablo, d As Object, i&, a, b()
Set P = Intersect(Range("A9:A" & Rows.Count), UsedRange)
If P Is Nothing Then ComboBox1.Clear: ComboBox1 = "": Exit Sub
If ComboBox1.ListIndex > -1 Then Union(P(0), P).AutoFilter 1, ComboBox1: Exit Sub 'filtre automatique
'---recherche intuitive---
x = ComboBox1 & "*"
tablo = P.Resize(P.Count + 1) 'matrice, plus rapide, au moins 2 éléments
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" And tablo(i, 1) Like x Then d(tablo(i, 1)) = ""
Next
If d.Count = 0 Then ComboBox1.Clear: ComboBox1 = "": Exit Sub
ComboBox1.List = d.keys
If FilterMode Then ShowAllData 'si la feuille est filtrée
ComboBox1.DropDown 'déroule la liste
End Sub

Fichier joint?

A+

 

[dreamso]

Bonjour

Sans plus de précisions sur ce que tu souhaites faire
voici un code

Sub Macro1()
Dim TabIni()  As Variant '==> on déclare un tableau
Set ListeComptes = CreateObject("Scripting.dictionary") 'on déclare un dictionaire


Application.ScreenUpdating = False 'on empeche le rafraichissemnt des feuilles


Set ActShe = ActiveSheet 'on enregistre la feuille active
With ActShe 'avec la feuille active
    Fin = .Range("A" & .Rows.Count).End(xlUp).Row 'on récupère la dernière ligne NON vide de la colonne A
    Set ZoneAFiltrer = .Range("A8:D" & Fin) 'on enregistre la zone à filtrer
    TabIni = .Range("A9:D" & Fin).Value 'on enregistre toutes les données dans le tableau vba
    For i = LBound(TabIni, 1) To UBound(TabIni, 1) 'pour chaque élémenent de la colonne A du tableau
        If Not ListeComptes.exists(TabIni(i, 1)) Then 'si le compte n'existe pas dans le dictionaire, on le crée
            ListeComptes.Add TabIni(i, 1), i
        End If
    Next i
    'ici, on a un dictionaire qui contien tous les numéros de comptes SANS doublon
End With
  
    For Each compte In ListeComptes.keys 'pour chaque compte
        Sheets.Add.Name = compte 'on crée une feuille du nom du compte
        ActShe.Activate 'on repasse sur la feuille Init
        Range("A1:D7").Copy Destination:=Sheets("" & compte & "").Range("A1") 'on copie l'entete

        ZoneAFiltrer.AutoFilter field:=1, Criteria1:=compte 'on filtre les données sur le numéro de compte
        ZoneAFiltrer.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("" & compte & "").Range("A8") 'on copie toutes les lignes filtrées
    Next compte
Application.ScreenUpdating = True 'on réactive le rafraichissement

End Sub

Note: vu le nombre important de comptes, l'execution dure quelques 20 à 30 s

MERCI
TON CODE RÉPOND EXACTEMENT A CE QUE JE CHERCHE.
SI C'EST POSSIBLE QUE SUR CHAQUE FEUILLE A VOIR A LA FIN DE LA LINGE VIDE LE TOTAL DU CREDIT ET DEBIT ET LE SOLDE.