Créer un tableau par VBA selon des conditions

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

J'ai 2 demandes : j'ai créé un codage qui met à jour un tableau de l'onglet "SYNTHESE VBA" en fonction de la colonne A B et C de l'onglet STC B2M
1 - Je souhaiterai que cette mise à jour se réalise en fonction de la couleur bleue de l'onglet et non en fonction de la dénomination STC B2M de l'onglet. J'ai essayé avec le codage ci-après mais cela ne fonctionne pas.
2 - Ensuite je souhaiterai que le tableau de l'onglet "SYNTHESE VBA" ait la mise en page ci-après donc j'ai crée un onglet Modele mais je n'ai pas trouvé le codage adéquat

Est-ce que vous pouvez m'aider ?

Mise en page souhaitée du tableau de l'onglet "SYNTHESE VBA" (que je n'arrive pas à coder)


J'ai joint un fichier illustratif

Merci pour votre aide





Sub test()
Dim Sh As Worksheet, C As Range
For Each Sh In Sheets
If Sh.Tab.ColorIndex = 33 Then

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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 VBA")
'With ws
'.UsedRange.Offset(21, 0).Clear
'End With

'With Sheets("STC B2M")
For Each cel In .Range("A7:A" & .Range("A" & rows.Count).End(xlUp).Row)

If cel.Offset(, 0) Like "*STC B2M*" Then
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

End If

Next cel
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Next Sh
End Sub


<bold>Onglet Modele qui sert à coder la mise en page du tableau de l'onglet "SYNTHESE VBA"</gras>



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 :

    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
    0