Discussion :

[iliesss]

Bonjour
le code suivant permettre de ventiler les valeur après un filtre dans chaque feuil par rapport au numéro de compte

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
Sub ventiler()
Dim a, e, dico As Object, wsName As String
    Application.ScreenUpdating = False
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets("Regroupe")
        With .Range("a1").CurrentRegion
            With .Offset(1).Resize(.Rows.Count - 1)
                a = .Columns(5).Offset(1).Resize(.Rows.Count - 1).Value
                For Each e In a
                    If Not dico.exists(e) Then
                        dico(e) = Empty
                        wsName = e
                        If Not Evaluate("isref('" & wsName & "'!a1)") Then
                            Sheets.Add(after:=Sheets(Sheets.Count)).Name = wsName
                        End If
 
                        .AutoFilter 5, e
                        .SpecialCells(xlCellTypeVisible).Copy Sheets(wsName).Cells(8, 1)
                        .AutoFilter
                    End If
                Next
            End With
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
 
End Sub

mes feuil sont de la même forme


Apres l’exécution du code les lignes "TOTAUX" et "SOLDE COMPTABLE RECTIFI" et "DIFF" sont écraser par les nouvelles valeurs
j'ai essayé de remplacer l'expression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

specialCells(xlCellTypeVisible).Copy

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.SpecialCells(xlCellTypeVisible).Insert Shift:=xlDown

mais ça marche pas

Aidez moi Svp

[Menhir]

Ce n'est pas le Copy qu'il faut remplacer par Insert mais le Paste.
Dans ton cas, le Paste est induit dans la méthode Copy. Il faut le séparer (en enlevant la destination de Copy).
Faire un Copy simple sur une ligne de code puis dans une autre ligne faire un Insert sur la destination.

[iliesss]

Salut Mr Menhir

Jai essayé cette solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.SpecialCells(xlCellTypeVisible).Copy
.Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

Mais vraiment je suis coincé
Aidez moi svp

[Menhir]

Jai essayé cette solution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.SpecialCells(xlCellTypeVisible).Copy
.Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

Le point en début de ligne signifie que le code vient se mettre en continuité avec le contenu du dernier With.

Ta seconde ligne est donc équivalente à :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Regroupe").Range("a1").CurrentRegion.Offset(1).Resize(.Rows.Count - 1).Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

Comme il est peu probable de placer un Sheet comme enfant d'un Range, le code n'est pas cohérent.

D'après le code que tu as mis en début de sujet, ce que tu as écris ci-dessus devrais aller si tu enlève ce point liminaire (mais laisse celui de la ligne Copy bien sûr).

Petit détail : la prochaine fois que tu indiques un problème, ne te contente pas de dire "je suis coincé". Précise le message d'erreur renvoyé et la ligne de code signalée par le débugage. Ca facilite grandement les chances de repérer le problème.

[iliesss]

SAlut Mr Menhir
J'ai essayer mille fois et même avec ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
.SpecialCells(xlCellTypeVisible).Copy
Sheets(wsName).Cells(8, 1).Insert shift:=xlDown

mais j'ai rien comme resultat

[John Mc Evee]

Bonsoir iliesss,

Après avoir étudier ton code, j'avoue j'ai eu du mal à piger la logique (propre à chacun ). Surtout cette partie ci dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 With .Range("a1").CurrentRegion
       With .Offset(1).Resize(.Rows.Count - 1)
        '.....
       End With
End With

Donc je te propose un code qui copie des données en fonction d'une liste de compte (feuille regroupe) et qui les répartir par feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
'**************************************************************************************************
' NAME : Ventiler (PROCESS)
' DESCRIPTION : A partir d'une liste de compte, le processus va répartir les
' différentes lignes dans les feuilles associées (La jonction se fait par le
' nom de la feuille)
'**************************************************************************************************
Public Sub Ventiler()
 
    Dim oSheetData   As Excel.Worksheet  'Feuille avec le numéro du compte
    Dim oRangeData   As Excel.Range      'Plage des cellules à copier
    Dim oListAccount As Object           'Liste des comptes à exporter
    Dim oCellAccount As Object           'Cellule du compte actif
    Dim oTestAccount As Object           'Liste des comptes déjà testé
    Dim iLastRow     As Integer          'dernière ligne de la colonne 5 (feuille regroupe)
    Dim iFirstRow    As Integer          'Ligne des entêtes (feuille regroupe)
    Dim iLastColumn  As Integer          'Dernière colonne non vide sur la ligne des entêtes
    Dim iFirstColumn As Integer          'Première colonne à exporter
    Dim iNumberRow   As Integer          'Nombre de ligne à exporter
 
    Application.ScreenUpdating = False
 
    'Paramétrage
    iFirstRow = 8 ' Saisir la ligne de tes en-têtes
    iFirstColumn = 1 'Saisir la première colonne de copie
 
    Set oTestAccount = VBA.CreateObject("Scripting.Dictionary")
 
    With Worksheets("Regroupe")
 
        If .FilterMode Then 'Si il y a un filtre d'activer
            .ShowAllData
        End If
 
        'Calcul de la plage
        iLastRow = .Cells(65000, 5).End(xlUp).Row
        iLastColumn = .Cells(iFirstRow, 255).End(xlToLeft).Column
 
        'Fixation de la plage
        Set oListAccount = .Range(.Cells(iFirstRow + 1, 5), .Cells(iLastRow, 5))
 
        For Each oCellAccount In oListAccount
 
            If Not oTestAccount.Exists(oCellAccount.Value) Then
                oTestAccount(oCellAccount.Value) = Empty
 
                'On initialise la feuille de destination
                On Error Resume Next
                Set oSheetData = Worksheets(CStr(oCellAccount))
                'Si elle n'existe pas on la créé
                If oSheetData Is Nothing Then
                    Set oSheetData = Sheets.Add(After:=Sheets(Sheets.Count))
                    oSheetData.Name = oCellAccount
                End If
 
                'Application du filtre
                .Range(iFirstRow & ":" & iFirstRow).AutoFilter 5, oCellAccount
 
                'Fixation de la plage à exporter
                Set oRangeData = .Range(.Cells(iFirstRow + 1, iFirstColumn), _
                                 .Cells(iLastRow, iLastColumn)).SpecialCells(xlCellTypeVisible)
 
                oRangeData.Copy 'Copie des données
 
                'On récupère le nombre de ligne à exporter
                iNumberRow = oRangeData.Rows.Count
 
                'Insertion des lignes dans la nouvelle feuille
                oSheetData.Rows("9:" & 9 + iNumberRow).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
 
                Set oSheetData = Nothing
                Set oRangeData = Nothing
 
            End If
 
        Next oCellAccount
 
        .ShowAllData
 
        Set oListAccount = Nothing
        Set oTestAccount = Nothing
 
    End With
 
End Sub

Avec le fichier de test ci-joint : Ventiler.xlsm

En espérant avoir saisie ton problème de ventilation (au passage un terme très comptable ).

A+