Autres Problème Macro VBA

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 !

Roms2603

XLDnaute Nouveau
Bonjour à tous,

Je rencontre un problème dans la programmation VBA (je suis débutant dans ce domaine j'apprends sur les forums).
Je vous joins le fichier concerné.
En effet lorsque je sélectionne une valeur dans la liste déroulante en D109 de la première feuille, la macro (qui concerne les éléments en feuille 2) doit se lancer hors en testant le programme il détecte une erreur.
Pouvez-vous jeter un oeil sur ce fichier ?

Cordialement.
 

Pièces jointes

Bonjour,

Je ne comprends pas. Il n'y a pas de code attaché au changement de valeur de la cellule D109. Par ailleurs, il n'y a pas de combobox mais une liste de validation de données. Il faut donc une macro "Worksheet_Change". Est-ce que tu veux un exemple ?

Par ailleurs, de quelle erreur parles-tu ?

Cordialement.

Daniel
 
Je joins le tableau modifié pour exemple :

Lorsque je sélectionne sur le menu déroulant en D109 (feuille "entête") la valeur "AMSLER ISO" je souhaiterai que la sélection surlignée en verte (feuille "Traction ambiante") apparaisse en feuille "entête" à partir de la case A111.
Lorsque je sélectionne sur le menu déroulant en D109 (feuille "entête") la valeur "AMSLER ISO ALU" je souhaiterai que la sélection surlignée en rouge (feuille "Traction ambiante") apparaisse en feuille "entête" à partir de la case A111.
Et ainsi de suite...
Je ne sais pas si je suis assez clair.
N'hésitez pas si vous avez des questions

Cordialement

Romain
 

Pièces jointes

Avec cette macro :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Ligne As Long, Plage As Range
  If Target.Address = "$D$109" And Target.Count = 1 Then
    If Target <> "" Then
      With Sheets("Traction ambiante")
        Ligne = Application.Match(Target, .[B:B], 0)
        If IsNumeric(Ligne) Then
          Set Plage = .Range(.Cells(Ligne + 1, 2), .Cells(Ligne + 1, 2).End(xlDown)).Resize(, 7)
          Application.EnableEvents = False
          [A111:A114] = ""
          Plage.Copy
          [A111].Resize(Plage.Rows.Count, Plage.Columns.Count).Value = Plage.Value
          Application.EnableEvents = True
        End If
      End With
    End If
  End If
End Sub
 

Pièces jointes

Un grand merci pour cette macro c'est exactement ce que je voulais.

Par contre lorsque que les sélections en feuille "traction ambiante" se copient sur la feuille "entête" la colonne I ne s'affiche pas alors qu'elle est bien demandée dans la macro.
Et lorsque j'efface ce qu'il y a en D109 feuille "entête" cela n'enlève pas les valeurs copiées précedemment
Pouvez-vous m'aider s'il vous plait ?

Cordialement
 
La macro devient :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Ligne As Long, Plage As Range
  If Target.Address = "$D$109" And Target.Count = 1 Then
    If Target <> "" Then
      With Sheets("Traction ambiante")
        Ligne = Application.Match(Target, .[B:B], 0)
        If IsNumeric(Ligne) Then
          Set Plage = .Range(.Cells(Ligne + 1, 2), .Cells(Ligne + 1, 2).End(xlDown)).Resize(, 8)
          Application.EnableEvents = False
          [A111:I1000] = ""
          Plage.Copy
          [A111].Resize(Plage.Rows.Count, 8).Value = Plage.Value
          Application.EnableEvents = True
        End If
      End With
    End If
  ElseIf Target.Address = "$D$109:$E$109" And Target.Count = 2 And [D109] = "" Then
    Application.EnableEvents = False
    [A111:I1000] = ""
    Application.EnableEvents = True
  End If
End Sub
 

Pièces jointes

Merci beaucoup 😉
Ca fonctionne très bien.

Petite question juste pour information (si je tombe sur un cas spécifique) :
Si j'insère des lignes au dessus de la ligne 109 de la feuille "entête", la macro ne fonctionne plus, est-ce possible de la figer en mettant des $ ou non ?

Cordialement
 
Essaie :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Ligne As Long, Plage As Range, L As Variant
  On Error Resume Next
  L = Target.Validation.Formula1
  If Err.Number > 0 Then
    Err.Clear
    Exit Sub
  End If
  If Target.Count = 1 Then
    L = Target.Row
    If Target <> "" Then
      With Sheets("Traction ambiante")
        Ligne = Application.Match(Target, .[B:B], 0)
        If IsNumeric(Ligne) Then
          Set Plage = .Range(.Cells(Ligne + 1, 2), .Cells(Ligne + 1, 2).End(xlDown)).Resize(, 8)
          Application.EnableEvents = False
          Range("A" & L + 2 & ":I" & 10000).ClearContents
          Plage.Copy
          Range("A" & L + 2).Resize(Plage.Rows.Count, 8).Value = Plage.Value
          Application.EnableEvents = True
        End If
      End With
    End If
  ElseIf Target.Count = 2 And Target(1) = "" Then
    On Error Resume Next
    L = Target.Validation.Formula1
    If Err.Number > 0 Then
      Err.Clear
      Exit Sub
    End If
    L = Target.Row
    Application.EnableEvents = False
    Range("A" & L + 2 & ":I" & 10000).ClearContents
    Application.EnableEvents = True
  End If
End Sub
 

Pièces jointes

Bonjour,

Désolé de répondre tard (je ne travaillais pas hier).
Concernant l'insertion de ligne cela fonctionne, les macros restent actives.
Cependant lorsque j'efface ce qu'il y a en D109 feuille "entête" cela n'enlève pas les valeurs copiées précédemment (comme dans le message de mardi à 13h55).

Cordialement
 
Bonjour,

Désolé de répondre tard (je ne travaillais pas hier).
Concernant l'insertion de ligne cela fonctionne, les macros restent actives.
Cependant lorsque j'efface ce qu'il y a en D109 feuille "entête" cela n'enlève pas les valeurs copiées précédemment (comme dans le message de mardi à 13h55).

Cordialement

Bonjour,

Euh, si... Sauf si tu sélectionnes plusieurs cellules et que tu les effaces ?

Daniel
 
- 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
33
Affichages
703
Réponses
4
Affichages
373
Réponses
4
Affichages
243
Retour