XL 2019 Ne pas faire apparaitre des lignes vides

  • Initiateur de la discussion Initiateur de la discussion Tarrain
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Tarrain

XLDnaute Junior
Bonjour,

j'ai fait un petit fichier avec un onglet avec des données et je souhaite dans un autre onglet faire des etiquettes et une liste en fonction des données rentrées, pas de soucis jusque là mais quand je fais mes etiquettes ou ma liste je souhaiterai que les lignes sans données n'apparaissent pas car dans données je me suis laissé la possibilité dans rajouter ou enlever au besoin.

Mieux qu'un grand discours, je vous envoie en FJ unbout de mon fichier
J'ai remis une petite explication dans le deuxieme onglet etiquette qui vaut aussi pour l'onglet liste

Merci pour votre aide

Seb
 

Pièces jointes

Bonjour Tarrain,

La macro dans la feuille Etiquettes :
VB:
Private Sub Worksheet_Activate()
Dim tablo(), c As Range, n&, c1 As Range
ReDim tablo(1 To Rows.Count, 1 To 1) 'matrice, plus rapide
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
Range("B3:B" & Rows.Count).Clear 'RAZ
For Each c In Sheets("données").Columns(1).SpecialCells(xlCellTypeConstants)
    If c <> "" Then
        n = 0
        For Each c1 In c(1, 2).Resize(c.MergeArea.Count).SpecialCells(xlCellTypeConstants)
            n = n + 1
            tablo(n, 1) = c1(1, 2) & c1
        Next c1
        Set c1 = Range("B" & Rows.Count).End(xlUp)(2)
        If c1.Row < 3 Then Set c1 = Range("B3")
        c1.Resize(n) = tablo
        c1.Resize(n).Font.Color = c.Font.Color 'couleur police
    End If
Next c
End Sub
La macro dans la feuille Liste, très voisine :
VB:
Private Sub Worksheet_Activate()
Dim tablo(), c As Range, n&, c1 As Range
ReDim tablo(1 To Rows.Count, 1 To 1) 'matrice, plus rapide
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
Range("B3:B" & Rows.Count).Clear 'RAZ
For Each c In Sheets("données").Columns(1).SpecialCells(xlCellTypeConstants)
    If c <> "" Then
        n = 0
        For Each c1 In c(1, 2).Resize(c.MergeArea.Count).SpecialCells(xlCellTypeConstants)
            n = n + 1
            tablo(n, 1) = c1(1, 2) & c1
        Next c1
        Set c1 = Range("B" & Rows.Count).End(xlUp)(3)
        If c1.Row < 5 Then Set c1 = Range("B5")
        c1(0) = c 'nom de la couleur
        c1.Resize(n) = tablo
        c1.Resize(n).Font.Color = c.Font.Color 'couleur police
    End If
Next c
End Sub
A+
 

Pièces jointes

Les macros se déclenchent automatiquement quand on active les feuilles.

Dans ce fichier (2) je les ai légèrement modifiées, feuille Etiquettes :
VB:
Private Sub Worksheet_Activate()
Dim tablo(), c As Range, n&, c1 As Range
ReDim tablo(1 To Rows.Count, 1 To 1) 'matrice, plus rapide
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
Range("B3:B" & Rows.Count).Clear 'RAZ
For Each c In Sheets("données").Columns(1).SpecialCells(xlCellTypeConstants)
    If c <> "" Then
        n = 0
        For Each c1 In c(1, 2).Resize(c.MergeArea.Count)
            If c1 <> "" Then
                n = n + 1
                tablo(n, 1) = c1(1, 2) & c1
            End If
        Next c1
        Set c1 = Range("B" & Rows.Count).End(xlUp)(2)
        If c1.Row < 3 Then Set c1 = Range("B3")
        c1.Resize(n) = tablo
        c1.Resize(n).Font.Color = c.Font.Color 'couleur police
    End If
Next c
End Sub
Feuille Liste :
VB:
Private Sub Worksheet_Activate()
Dim tablo(), c As Range, n&, c1 As Range
ReDim tablo(1 To Rows.Count, 1 To 1) 'matrice, plus rapide
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
On Error Resume Next 'si aucune SpecialCell
Range("B3:B" & Rows.Count).Clear 'RAZ
For Each c In Sheets("données").Columns(1).SpecialCells(xlCellTypeConstants)
    If c <> "" Then
        n = 0
        For Each c1 In c(1, 2).Resize(c.MergeArea.Count)
            If c1 <> "" Then
                n = n + 1
                tablo(n, 1) = c1(1, 2) & c1
            End If
        Next c1
        Set c1 = Range("B" & Rows.Count).End(xlUp)(3)
        If c1.Row < 5 Then Set c1 = Range("B5")
        c1(0) = c 'nom de la couleur
        c1.Resize(n) = tablo
        c1.Resize(n).Font.Color = c.Font.Color 'couleur police
    End If
Next c
End Sub
Le fichier (1) présentait un petit défaut quand on effaçait par exemple B3:B6.
 

Pièces jointes

je viens de rgarder ca à l'air super par contre je voulais regarder les macros pas a pas mais dans macro je ne les vois pas -
je souhaitai modifier car là j'ai le prénom collé au nom
je souhaitai rajouter des lignes à la fin de chaque groupe ( j'en voulai 15 par groupe
je souhaitai mettre au moins deux lignes au dessus des couleurs pour séparer dans l'onglet liste
encore merci
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
0
Affichages
555
Réponses
1
Affichages
1 K
Retour