Macro Saut de ligne

Bonjour le Forum

Je crée un nouveau sujet concernant ma demande d'aide (Désolé , je l'avais posté dans un sujet résolu)

Je travail sur un projet qui comporte plusieurs Feuilles.

Chaque feuille est composée d'un tableau structuré avec les même entêtes , la différence n'est que le nombre de ligne.

Ce code que j'ai eu sur une précédente demande , avait pour but:

A partir de la colonne ("D3") si ("C3") est vide alors ne rien écrire et passer à la ligne suivant.

Option Explicit

Private Sub Worksheet_Activate()
   Range("B3").Activate   'Repositionner le tableau
End Sub

    'PROCEDURE SI COLONNE C VIDE ALORS D VIDE

Private Sub Worksheet_Change(ByVal Target As Range)

 Dim nL As Long, nC As Integer
    If Target.Column <> 4 Or Target.Row < 3 Then Exit Sub 'SI colonne et Ligne hors cible sort procedure

        Application.EnableEvents = False    'Mise au repos de la  Gestion de l'événement--> Eviter que la macro se boucle à l'infini
            nL = Target.Row                 'ligne
            nC = Target.Column              ' Colonne
            If Trim(Cells(nL, nC - 1)) = vbNullString Then       'Regarde à gauche si vide
                Target.Value = vbNullString                 'Si vide -> ne rien mettre
                Cells(nL + 1, nC).Activate            'Active Ligne suivante
            End If
        Application.EnableEvents = True
End Sub

En continuant mon projet, je m’aperçois que cela n'est pas judicieux.
J'aimerais pouvoir faire:
A partir de la colonne ("D3:I3") si "C3" est vide alors ne rien écrire et passer à la ligne suivant.

J'espère que mes explications sont compréhensibles
Je joint l'exemple d'une feuille de mon projet
Pour info: en colonne ("D") et ("I"), il y a une mise en forme conditionnelle, qui oblige la saisie de 3 possibilités de texte.
Soit N
Soit O
Soit PE

Merci

Bonne journée à tous

bonjour,

vous avez plusieurs feuilles parreilles ?

in Thisworkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
     Application.Goto Sh.Range("B3"), 0  'Repositionner le tableau
End Sub

'PROCEDURE SI COLONNE C VIDE ALORS D VIDE
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

     Dim DBR, c, c1, lc
     With Sh.Range("B2").ListObject
          If .ListRows.Count < 2 Then Exit Sub
          Set DBR = .DataBodyRange
          Set c = Intersect(Target, DBR.Offset(1, 2).Resize(DBR.Rows.Count - 1, DBR.Columns.Count - 2))
           If c Is Nothing Then Exit Sub
          If c.Cells.Count > 1 Then Exit Sub
          lc = .ListColumns("Equipement").Range.Column
          Set c1 = c.Offset(, lc - c.Column)
          If Trim(c1.Value) = vbNullString Then   'Regarde à gauche si vide
               Application.EnableEvents = False
                c1.Resize(, .ListColumns.Count - .Range.Column + lc + 1).ClearContents          'Si vide -> ne rien mettre
               Application.EnableEvents = True
          End If
     End With
End Sub

Bonsoir le Forum

Bonsoir BsAlv , merci pour votre réponse , c'est top.

Je ne l'ai pas encore mis dans mon projet ( ce week surement)

J'ai essayé de le comprendre, mais étant au début de mon auto apprentissage, je suis resté avec mes questions .

Serait-il possible que vous ajoutiez les commentaires svp.

Merci

Bonne soirée à tous

Bonjour le forum

Bonjour BsAlv, j'ai un soucis avec ton code quand je l'insert dans mon projet

'PROCEDURE SI COLONNE C VIDE ALORS D VIDE
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

     Dim DBR, c, c1, lc

     For I = 3 To Worksheets.Count  
     With Sh.Range("B2").ListObject
          If .ListRows.Count < 2 Then Exit Sub
          Set DBR = .DataBodyRange
          Set c = Intersect(Target, DBR.Offset(1, 2).Resize(DBR.Rows.Count - 1, DBR.Columns.Count - 2))
           If c Is Nothing Then Exit Sub
          If c.Cells.Count > 1 Then Exit Sub
          lc = .ListColumns("Equipement").Range.Column
          Set c1 = c.Offset(, lc - c.Column)
          If Trim(c1.Value) = vbNullString Then   'Regarde à gauche si vide
               Application.EnableEvents = False
                c1.Resize(, .ListColumns.Count - .Range.Column + lc + 1).ClearContents          'Si vide -> ne rien mettre
               Application.EnableEvents = True
          End If
     End With
     Next
End Sub

sur cette ligne

If .ListRows.Count < 2 Then Exit Sub

sur ton fichier en retour, je n'ai pas ce problème

Je continue mes recherches dans l'attente d'une réponse

Bonne journée

Private Sub Workbook_SheetChange(By     -----> veut dire que cette macro doit se trouver dans "ThisWorkbook" pour les events qui sont provoqués par le changement de cellule(s). Donc ne peut pas se trouver quelque part ailleurs.

For I = 3 To Worksheets.Count     '-----> je ne comprends pas ce boucle, c'est quoi le but ?
     With Sh.Range("B2").ListObject   '---> regarde vers le tableau qui ce trouve autour de la cellule B2 de la feuille de changement
          If .ListRows.Count < 2 Then Exit Sub    '---> Y-a-t-il moins que 2 listrows dans ce tableau ?

Je pense que quand vous obtenez ce message, que vous changez une cellule dans une feuille où il n'y a pas de tableau autour de B2 de cette feuille. Donc, juste avant que vous avez obtenu ce message, c'était quoi la dernière chose que vous ou VBA avez fait ?

C'est quoi, le but du boucle "For I=3 to worksheets.count ?

Re BsAlv

Pour:

Private Sub Workbook_SheetChange(By     -----> veut dire que cette macro doit se trouver dans "ThisWorkbook" pour les events qui sont provoqués par le changement de cellule(s). Donc ne peut pas se trouver quelque part ailleurs.

Pour cela ok , j'ai bien compris la méthode

Pour

For I = 3 To Worksheets.Count

je n'utilise ta proposition qu'a partir de la feuille 3.

Les 2 feuilles se trouvant avant sont:

Data -> regroupe mes données pour traitement

Administrateur-> cette feuille regroupe des graphs ( c'est une vue d'ensemble de mon analyse des toutes les feuilles à partir de la 3

mais n'importe quelle cellule dans n'importe quelle feuille que vous changez, cette macro est invoquée. (même Data et Administrateur")

Et alors, dans toutes les feuilles, y-a-t-il dans B2 un tableau (=listobject), si non, on ne pas lui demander son nombre de lignes. Puis ce boucle n'a pas de sens, parce que le "i", vous ne l'utilisez nulle part

C'est quoi le but de cette macro et pourquoi dans ThisWorkbook ?

Re BsAlv

mais n'importe quelle cellule dans n'importe quelle feuille que vous changez, cette macro est invoquée. (même Data et Administrateur")

Ok maintenant je comprends mieux.

Donc il faut préciser que la macro ne s'exécute qu'a partir de la feuille 3

C'est quoi le but de cette macro et pourquoi dans ThisWorkbook ?

c'est vous qui me l'avais suggéré.

De mon côté je n'ai pas donné suffisamment de détail.

Mon Projet:

A partir de la feuille 3 la structure est la même, la différence est le nbre de ligne

Une feuille DATA (feuille cachée) -> comptabilise des données des feuilles a partir de la feuille 3 jusque la dernière (soit 19 à ce jour)

Une feuille ADMINISTRATEUR -> analyse par 3 graphs , les données des graphs sont issue de la feuille data

voila le projet.

Il est difficile à ce stade de le mettre sur le forum (trop de données)

j'espère avoir répondu à ta demande

merci de ton aide

Re a tous

BsAlv, je pense avoir trouvé la solution.

Je vérifie cela en profondeur

 Dim I As Integer:
      For I = 3 To Sheets.Count                          'Boucle de feuil 3 à la dernière

Je suis resté sur ma première intention, en utilisant comme tu me l'as conseillé ton code dans ThisWorkbook.

Pour l’instant plus de bug

Je reviens dès que possible pour le partage

A bientôt

re, ou ceci ?

Option Compare Text     '1ière ligne dans ce module !!!!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

     Dim DBR, c, c1, lc
     Select Case Sh.Name
          Case "Data", "Administrateur"     'pour ces feuilles rien faire
          Case Else     'toutes les autres feuilles
               With Sh.Range("B2").ListObject     'le tableau autour de B2 de la feuille changée
                    If .ListRows.Count < 2 Then Exit Sub     'assez de lignes
                    Set DBR = .DataBodyRange     'les données sans les entêtes
                    Set c = Intersect(Target, DBR.Offset(1, 2).Resize(DBR.Rows.Count - 1, DBR.Columns.Count - 2))     'uniquement les cellules qui sont changées dans colonnes 2-3
                    If c Is Nothing Then Exit Sub     'les changements sont dehors colonne 2-3 = FIN
                    If c.Cells.Count > 1 Then Exit Sub     'plus qu'une cellule changée en même temps = FIN
                    lc = .ListColumns("Equipement").Range.Column     'le numéro de la colonne "Equipement"
                    Set c1 = c.Offset(, lc - c.Column)     'la cellule "Equipement" dans la même ligne
                    If Trim(c1.Value) = vbNullString Then   'Regarde à gauche si vide
                         Application.EnableEvents = False     'ignorer les events
                         c1.Resize(, .ListColumns.Count - .Range.Column + lc + 1).ClearContents          'Si vide -> ne rien mettre
                         Application.EnableEvents = True     'ne plus ignorer les events
                    End If
               End With
     End Select
End Sub

Bonjour le forum

Bonjour BsAlv

Merci pour la modif, en plus avec les commentaires c'est top.

Ton code fonctionne correctement quand je fais de la saisie dans les différentes feuilles.

Par contre, j'ai rencontré un problème.

Si je voulais saisir dans une cellule de la feuille DATA OU ADMINISTRATEUR -> bug macro, le même que celui ( Hier à 12:17)

Je pensais que excel ne faisais pas la différence entre majuscule et minuscule

 Dim DBR, c, c1, lc
     Select Case Sh.Name
          Case "Data", "Administrateur"     'pour ces feuilles rien faire
          Case Else     'toutes les autres feuilles

autre bonne nouvelles:

J'ai une procédure d'initialisation dans mon projet, c'est à dire que le fichier remet à l'état initiale l'ensemble des feuilles du classeur

Avec ton:

Dim DBR, c, c1, lc
     Select Case Sh.Name
          Case "DATA", "ADMINISTRATEUR"     'pour ces feuilles rien faire
          Case Else     'toutes les autres feuilles

Plus de blocage non plus.

Je pense que tu as résolu mon problème dans sa totalité

Je laisse le post ouvert pour l'instant, reviens plus tard pour le clôturer.

D'ici là un grand merci pour ton aide.

Bonne après-midi à tous

Dans mon poste de hier 21:07, la première ligne devrait être "Option Compare Text '1ière ligne dans ce module !!!!"

si non, il y a une différence entre les majuscules et les minuscules.

Autre methode est avec StrComp("Texte1", "Texte2", 1) = 0 ou tout mettre en majuscules avec Select Case ucase(Sh.Name)

Donc si vous ajoutez cette première ligne ...

Bonjour le forum

bonjour BsAlv, désolé si j'ai oublié de copier la totalité de ton code

Mais oui

'Option Compare Text     '1ière ligne dans ce module !!!!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

     Dim DBR, c, c1, lc
     Select Case Sh.Name
          Case "DATA", "ADMINISTRATEUR"     'pour ces feuilles rien faire
          Case Else     'toutes les autres feuilles
               With Sh.Range("B2").ListObject     'le tableau autour de B2 de la feuille changée
                    If .ListRows.Count < 2 Then Exit Sub     'assez de lignes
                    Set DBR = .DataBodyRange     'les données sans les entêtes
                    Set c = Intersect(Target, DBR.Offset(1, 2).Resize(DBR.Rows.Count - 1, DBR.Columns.Count - 2))     'uniquement les cellules qui sont changées dans colonnes 2-3
                    If c Is Nothing Then Exit Sub     'les changements sont dehors colonne 2-3 = FIN
                    If c.Cells.Count > 1 Then Exit Sub     'plus qu'une cellule changée en même temps = FIN
                    lc = .ListColumns("Equipement").Range.Column     'le numéro de la colonne "Equipement"
                    Set c1 = c.Offset(, lc - c.Column)     'la cellule "Equipement" dans la même ligne
                    If Trim(c1.Value) = vbNullString Then   'Regarde à gauche si vide
                         Application.EnableEvents = False     'ignorer les events
                         c1.Resize(, .ListColumns.Count - .Range.Column + lc + 1).ClearContents          'Si vide -> ne rien mettre
                         Application.EnableEvents = True     'ne plus ignorer les events
                    End If
               End With
     End Select
End Sub

le code est bien dans sont intégralité

Pour ma part question résolue à ce jour

Encore merci et à bientôt sur le forum