Discussion :

[DragZZ]

bonjour le forum


Je vous écris car j'ai besoin de votre aide pour générer des écritures comptables avec une macro en filtrant certaines données de notre premières fiche

Le but étant de : Par la feuille 1(regarde exemple) générer les écritures de la feuilles 2

pour y arriver j'utilise une macro mais je n'arrive pas a l'adapter

Est ce que quelqu'un pourrait m'aider s'il vous plait ?

Voici ma macro et le fichier ci-dessous est mon exemple La base de données (Feuil1)

cordialement Merci

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
Sub MacroFactures()
 
'
' Test Macro
'
Dim i%, iRC&, WsC As Worksheet, THdr
Application.ScreenUpdating = False
Worksheets.Add.Name = "FiltreReglement" & Worksheets.Count + 1
Set WsC = ActiveSheet
THdr = Split("date rgt,code journal,compte,débit,crédit,Libellé,pièce,référence pièce", ",")
    For i = 0 To UBound(THdr)
    WsC.Cells(2, 1 + i) = THdr(i)
    Next
        iRC = 3
        ArrS = Feuil1.[A1].CurrentRegion.Value2
        For i = 2 To UBound(ArrS)
        THdr(0) = Format(CDate(ArrS(i, 3)), "dd/mm/yyyy")
        THdr(1) = "RGLT"
        THdr(2) = "411" & ArrS(i, 5)
        THdr(3) = ""
        THdr(4) = ArrS(i, 12)
        THdr(5) = ArrS(i, 6)
        THdr(6) = ArrS(i, 10)
        THdr(7) = ArrS(i, 13)
        WsC.Cells(iRC, 1).Resize(1, UBound(THdr) + 1) = THdr
        iRC = iRC + 1
        THdr(3) = ArrS(i, 11)
        THdr(4) = ""
        WsC.Cells(iRC, 1).Resize(1, UBound(THdr) + 1) = THdr
        iRC = iRC + 1
        Next
 
    Columns("F:F").ColumnWidth = 26.14
    Columns("G:G").ColumnWidth = 31.57
    Columns("H:H").ColumnWidth = 19.14
    Columns("B:B").ColumnWidth = 15
 
        Range("A2:H2").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

le rendu (Feuil2)