Autres Problème Macro VBA

[Roms2603]

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.

 

[danielco]

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

 

[Roms2603]

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

 

[danielco]

Avec cette macro :

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

 

[Roms2603]

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

 

[danielco]

La macro devient :

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

 

[Roms2603]

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

 

[danielco]

Essaie :

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

 

[Roms2603]

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

 

[danielco]

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

 

[Roms2603]

Bonjour,

En effet cela fonctionne. J'avais réalisé une mauvaise manip.
Encore merci pour l'aide

Cordialement.