Tableau crée par VBA sous certaines conditions

Résolu
Dreampower75 Messages postés 91 Statut Membre -  
Dreampower75 Messages postés 91 Statut Membre -
Bonjour,

Je souhaiterai créée par VBA un tableau dans l'onglet "SYNTHESE" en fonction des éléments des onglets verts (STC B2M....) et du modèle de l'onglet MODELE
J'ai ajouté sur la partie droite de l'onglet "SYNTHESE" le résultat que je souhaiterai obtenir.

Je souhaiterai que le tableau de l'onglet "SYNTHESE" reprennent toutes les lignes du tableau des onglets verts (STC B2M / 1002347 / CORDON...) séparés d'une ligne en noire en gras qui sépare les simulateurs avec le tableau modèle de l'onglet "MODELE".

J'ai crée un lien ou j'ai joint un fichier illustratif : https://www.transfernow.net/dl/20220504mIVONAaA
Merci de votre aide.

- ONGLET SYNTHESE -


- ONGLET VERT -


- ONGLET MODELE -


Configuration: Windows / Chrome 100.0.4896.127

1 réponse

  1.
    Dreampower75 Messages postés 91 Statut Membre 2
     
    Bonjour,

    J'ai trouvé la solution qui est le codage ci-après :


    <ital>Sub test()

    '''xxxxxxxxxxxxxxxxx EFFACEMENT DES DONNEES EXIXTANTES xxxxxxxxxxxxxxxxxxxx'''''
    ThisWorkbook.Activate
    Sheets("SYNTHESE").Select
    Range("B7:N100000").Select
    Selection.Clear

    '''xxxxxxxxxxxxxxxxx EFFACEMENT DES DONNEES EXIXTANTES xxxxxxxxxxxxxxxxxxxx'''''

    Dim Titre, dt As Integer, ws As Worksheet, cel As Range, n As Integer
    Dim nbLignes As Long

    ', dest As Range
    Dim Deb As Long
    Set ws = ThisWorkbook.Worksheets("SYNTHESE")
    Dim Sh As Worksheet, C As Range

    For Each Sh In Sheets
    If Sh.Tab.ColorIndex = 33 Then

    '''''''''''''''''''''''''' RISK '''''''''''''

    For Each cel In Sh.Range("A7:A" & Sh.Range("A" & Rows.Count).End(xlUp).Row)

    dt = ws.Cells(Rows.Count, 2).End(xlUp).Row + 1

    ws.Range("B" & dt) = cel.Offset(, 0)
    ws.Range("C" & dt) = cel.Offset(, 1)
    ws.Range("D" & dt) = cel.Offset(, 2)
    ws.Range("E" & dt).Formula = ws.Range("X" & dt).Formula
    ws.Range("F" & dt).Formula = ws.Range("Y" & dt).Formula
    ws.Range("G" & dt).Formula = ws.Range("Z" & dt).Formula
    ws.Range("H" & dt).Formula = ws.Range("AA" & dt).Formula
    ws.Range("I" & dt).Formula = ws.Range("AB" & dt).Formula
    ws.Range("J" & dt).Formula = ws.Range("AC" & dt).Formula
    ws.Range("K" & dt).Formula = ws.Range("AD" & dt).Formula
    ws.Range("L" & dt).Formula = ws.Range("AE" & dt).Formula
    ws.Range("M" & dt).Formula = ws.Range("AF" & dt).Formula
    ws.Range("N" & dt).Formula = ws.Range("AG" & dt).Formula

    Next cel

    '''''''''''''''''''''''''' RISK '''''''''''''

    End If
    Next Sh

    ''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''

    Range("B7:N10000").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    End With

    ''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N'''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''ALIGNEMENT DE LA CELLULE B à N''''''''''''''''''''''''

    ''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''

    Range("E7:N10000").Select
    Application.CutCopyMode = False
    Selection.Style = "Comma"
    Selection.NumberFormat = _
    "_-* #,##0.0 _€_-;-* #,##0.0 _€_-;_-* ""-""?? _€_-;_-@_-"
    Selection.NumberFormat = "_-* #,##0 _€_-;-* #,##0 _€_-;_-* ""-""?? _€_-;_-@_-"

    ''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''mettre les cellules à "-"''''''''''''''''''''''''

    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE

    ThisWorkbook.Sheets("MODELE").Range("A3:M4").Copy
    With ws.Range("B1:N10000")
    For i = 7 To dt
    If .Range("B" & i) <> "Totalazerty" And .Range("B" & i) <> "" Then
    .Rows(i).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
    Next i
    End With

    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE
    ''''''''''''''''''''''''zzzzzzzzzzzzzzzzzzzzzzzzzzz MISE EN PAGE

    Range("P10").Select

    End Sub
    </ital>
    0