Mise en forme automatique d'un tableau variable

Le 15/02/2021 à 22:19

Bonjour à tous,

J'aurai besoin d'un peu d'aide pour la conception d'une macro car j'ai atteint mes limites en VBA sur ce point

Je souhaite réaliser une macro ayant pour objectif :
-> De dupliquer autant de fois que nécessaire mon "onglet de base" à l'aide d'une liste définie (ok)
-> De rapatrier automatiquement des informations en fonction d'un critère sur les onglets générés (ok)
-> D'adapter la mise en forme du tableau en fonction des informations rapatriées qui sont différentes d'un onglet à l'autre en terme de nombre (je ne sais pas faire)
-> De faire un calcul de somme sur plusieurs colonnes en dessous de la dernière ligne non vide sur certaines colonnes (non encore réalisé car je bloque sur l'étape d'avant)

J'ai un onglet : "onglet_base" qui est celui que je duplique en fonction d'une liste
Mon tableau commence de B24 à K(x). Je souhaite donc que la mise en forme s'adapte en fonction du nombre de ligne qui sont rapatriées.
Et je souhaite également faire une somme sur les colonnes E/F/H/I/J de la dernière ligne non vide à la ligne 24 des colonnes concernées.
La mise en forme souhaitée est sur mon "onglet_base"

Pouvez-vous m'aider ?
Mon fichier est en PJ

Ci-dessous mon code actuel :
Sub Creation_onglets()

    Dim ws_Liste As Worksheet
    Dim ws_base As Worksheet
    Dim position As Worksheet
    Dim name As String
    Dim Dl_1 As Long
    Dim Dl_2 As Long
    Dim Cible As String
    Dim wb As Workbook

    Dim WS_TARGET As Worksheet

    Application.ScreenUpdating = False 'Désactive la mise à jour de l'affichage
    Application.DisplayAlerts = False 'Désactive les messages d'alertes/erreurs (permet notamment d'écraser des fichiers existants)
    Application.Calculation = xlManual 'Désactive le calcul automatique des formules

    Set wb = ThisWorkbook
    Set WS_TARGET = wb.Worksheets("Prévision") 'défini ws_target comme la feuille Prévision
    Set ws_Liste = Worksheets("DATA") 'défini ws_liste comme la feuille DATA
    Set ws_base = Worksheets("Onglet_base") 'Défini ws_base comme la feuille Onglet_base
    Set position = Worksheets("REEL") 'Défini la variable position : Fait référence à la feuille "REEL"

        For L = 1 To ws_Liste.Range("A" & Rows.Count).End(xlUp).Row 'Commence à la ligne 1 jusqu'a la dernière ligne non vide de la colonne A sur la feuille DATA

        ws_base.Copy Before:=position 'Copie l'onglet "ws_base" et le positionne avant l'onglet REEL avec la référence position

        name = ws_Liste.Range("A" & L).Value 'Défini le nom de l'onglet à créer : Feuille DATA, colonne "A" ligne "L"
        Cible = ws_Liste.Range("A" & L).Value 'Défini la variable pour mettre à jour l'onglet créé en fonction de l'établissement souhaité : Feuille Data, colonne "A" ligne "L"

        ActiveSheet.name = name 'Applique à la feuille active le nom de l'onglet souhaité
        ActiveSheet.Range("B3") = Cible 'Applique à la feuille active l'établissement souhaité
        REF = ActiveSheet.Range("REF").Value

        Entete = Array("data1", "data2", "data3", "data4", "data5", "data6", "data7", "data8", "data9") 'Défini les entetes du notre tableau de réstitution n des données
        ActiveSheet.Range("B23").Resize(, UBound(Entete) + 1) = Entete

        Dl_1 = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row 'Détermine la dernière ligne non vide de la colonne B
        ActiveSheet.Range("B24:B" & Dl_1).Select 'Selectionne la plage B23 à B"Dl_1"
        Selection.ClearContents 'supprime la selection
        Dl_2 = WS_TARGET.Range("B" & Rows.Count).End(xlUp).Row 'Détermine la dernière ligne non vide de la colonne B de la feuille Prévision

        x = 24 'pour x = 24

            For i = 2 To Dl_2 'pour i = 2 à la dernière ligne non vide de la colonne B de la feuille Prévision

                Cible = WS_TARGET.Range("B" & i).Value 'Défini cible commme la cellule Bi de la feuille prévision
                If REF = Cible Then 'si REF = Cible alors

 'copier-coller:
                WS_TARGET.Range("E" & i).Copy
                ActiveSheet.Select

     ActiveSheet.Range("B" & x).Select
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      Application.CutCopyMode = False

    x = x + 1 'x = x +1 pour faire le collage de la boucle sur la ligne suivante

        End If

      Next

    Next

  Calculate

 End Sub
Je vous remercie par avance pour votre aide!

Bien cordialement,
20test-projet-v.zip (183.66 Ko)
Le 22/02/2021 à 11:50

Bonjour

-> De faire un calcul de somme sur plusieurs colonnes en dessous de la dernière ligne non vide sur certaines colonnes (non encore réalisé car je bloque sur l'étape d'avant)

Vous désirez une formule ou simplement la somme via VBA ?
les formules sont à prévoir où le mot "Somme" est mentionné ?

Cordialement

Le 22/02/2021 à 14:49

Bonjour,

Oui les somme sont à prévoir dans les cellules ou le mot somme est mentionné.

En revanche, la position sera variable d'un onglet à l'autre car le nombre de ligne rapatrié sera différent.

Je ne pense pas que le calcul des sommes me poseras des problèmes, en revanche je suis complètement perdu pour la mise en forme automatique du tableau en fonction du nombre de ligne rapatrié.

Je vous remercie d'avance pour l'aide apportée,

Bien cordialement,

Le 22/02/2021 à 17:33

Re,

Remplacez votre code par celui-ci :

Sub Creation_onglets_test()

    Dim ws_Liste As Worksheet
    Dim ws_base As Worksheet
    Dim position As Worksheet
    Dim Dl_1 As Long
    Dim Dl_2 As Long
    Dim L As Long
    Dim wb As Workbook
    Dim REF
    Dim Entete()

    Dim WS_TARGET As Worksheet

    Application.ScreenUpdating = False 'Désactive la mise à jour de l'affichage
    Application.DisplayAlerts = False 'Désactive les messages d'alertes/erreurs (permet notamment d'écraser des fichiers existants)
    Application.Calculation = xlManual 'Désactive le calcul automatique des formules

    Set wb = ThisWorkbook
    Set WS_TARGET = wb.Worksheets("Prévision") 'défini ws_target comme la feuille Prévision
    Set ws_Liste = Worksheets("DATA") 'défini ws_liste comme la feuille DATA
    Set ws_base = Worksheets("Onglet_base") 'Défini ws_base comme la feuille Onglet_base
    Set position = Worksheets("REEL") 'Défini la variable position : Fait référence à la feuille "REEL"

        For L = 1 To ws_Liste.Range("A" & Rows.Count).End(xlUp).Row 'Commence à la ligne 1 jusqu'a la dernière ligne non vide de la colonne A sur la feuille DATA

            ws_base.Copy Before:=position 'Copie l'onglet "ws_base" et le positionne avant l'onglet REEL avec la référence position

            With ActiveSheet
                .name = ws_Liste.Range("A" & L).Value 'Applique à la feuille active le nom de l'onglet souhaité
                .Range("B3") = ws_Liste.Range("A" & L).Value 'Applique à la feuille active l'établissement souhaité

                REF = .Range("REF").Value

                Entete = Array("data1", "data2", "data3", "data4", "data5", "data6", "data7", "data8", "data9") 'Défini les entetes du notre tableau de réstitution n des données
                .Range("B23").Resize(, UBound(Entete) + 1) = Entete

                Dl_1 = .Range("B" & .Rows.Count).End(xlUp).Row 'Détermine la dernière ligne non vide de la colonne B
                .Range("B24:B" & Dl_1).ClearContents 'Selectionne la plage B23 à B"Dl_1"

                Dl_2 = WS_TARGET.Range("B" & Rows.Count).End(xlUp).Row 'Détermine la dernière ligne non vide de la colonne B de la feuille Prévision

            End With

            Dim c As Range
            Dim prem As String

            Dl_1 = 24
            With WS_TARGET.Range("B2:B" & Dl_2)
                Set c = .Find(REF, LookIn:=xlValues)
                If Not c Is Nothing Then
                    prem = c.Address
                    Do
                        ActiveSheet.Range("B" & Dl_1) = WS_TARGET.Range("E" & c.Row)
                        Dl_1 = Dl_1 + 1
                        Set c = .FindNext(c)
                    Loop While Not c Is Nothing And c.Address <> prem
                End If
            End With

            With ActiveSheet
                'formule
                Union(.Range("E" & Dl_1 & ":F" & Dl_1), .Range("H" & Dl_1 & ":I" & Dl_1), .Range("K" & Dl_1)).FormulaR1C1 = "=SUM(R[-23]C:R[-1]C)"
                'Mise en forme
                With .Range("B24:F" & Dl_1 - 1)

                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With

                With .Range("G24:I" & Dl_1 - 1)
                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
                With .Range("J24:K" & Dl_1 - 1)
                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
            End With

        Next L

  'Calculate
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

 End Sub

Puis reliez le à votre bouton

Cordialement

Le 23/02/2021 à 18:08

Super!

Ça fonctionne nickel !

J'ai juste une petite question pour une amélioration.

Pour la mise en forme, le code est spécifique à la plage

                With .Range("B24:F" & Dl_1 - 1)

                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With

                With .Range("G24:I" & Dl_1 - 1)
                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With
                With .Range("J24:K" & Dl_1 - 1)
                    .Borders.LineStyle = xlContinuous
                    .BorderAround Weight:=xlThin
                    .Borders(xlInsideVertical).Weight = xlHairline
                    .Borders(xlInsideHorizontal).Weight = xlHairline
                End With

J'ai essayé de le réduire et de l'optimiser avec un range multiple mais cela ne fonctionne pas. J'aimerai savoir si cela est possible :

Mon code pour simplifier le code ci-dessus :

Set myMultipleRange = Union(.Range("B24:F" & Dl_1 - 1), .Range("G24:I" & Dl_1 - 1), .Range("J24:K" & Dl_1 - 1))
                    myMultipleRange.Borders.LineStyle = xlContinuous
                    myMultipleRange.BorderAround Weight:=xlThin
                    myMultipleRange.Borders(xlInsideVertical).Weight = xlHairline
                    myMultipleRange.Borders(xlInsideHorizontal).Weight = xlHairline

Sauf que le résultat me donne des lignes extérieures/intérieures en pointillés sur tout mon tableau.

Je n'arrive pas à obtenir des lignes extérieures continues, et des lignes intérieures en pointillés

Merci pour ton aide,

Bien cordialement,

Le 23/02/2021 à 18:18

Bonsoir

Inutile de faire un Set = ..., il suffirait de faire ceci

Union(.Range("B24:F" & Dl_1 - 1), .Range("G24:I" & Dl_1 - 1), .Range("J24:K" & Dl_1 - 1))

Mais cela ne fonctionne pas. J'avais testé cette solution avant de poster le code.

Cordialement

Rechercher des sujets similaires à "mise forme automatique tableau variable"