Tableau crée par VBA sous certaines conditions

Résolu

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention -
Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention - 6 mai 2022 à 10:35

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

A voir également:

Tableau crée par VBA sous certaines conditions
Tableau word - Guide
Tableau ascii - Guide
Cree un compte google - Guide
Trier un tableau excel - Guide
Tableau croisé dynamique - Guide

1 réponse

Réponse 1 / 1

Dreampower75 Messages postés 88 Date d'inscription Statut Membre Dernière intervention 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>

Discussions similaires

Formule taux de marque

Tableau croisé dynamique - absence de certaines données

Votre réponse

Discussions similaires