Tableau crée par VBA sous certaines conditions

Résolu/Fermé

Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 - Modifié le 4 mai 2022 à 11:19
Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 - 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 croisé dynamique - Guide
Tableau ascii - Guide
Tableau word - Guide
Cree un compte google - Guide
Cree un compte gmail - Guide

1 réponse

Réponse 1 / 1

Dreampower75 Messages postés 88 Date d'inscription jeudi 28 janvier 2021 Statut Membre Dernière intervention 18 juin 2022 2
Modifié le 6 mai 2022 à 10:36

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

ou sont les bananes ?

liste de noms par ordre alphabétique

Nom de champs du tableau croisé dynamique non valide

generateur de combinaison du loto 5/90

"L'indice n'appartient à la sélection" + VBA

Discussions similaires

Newsletters