Microsoft 365 Macro copie colle si condition

[Fanouille]

Bonjour à tous,

Je suis bloquée sur une macro VBA depuis ce matin :-(
Je cherche à copier/coller les lignes 2, 4 et 6 respectivement sur les lignes 3 5 et 7 si la valeur de la cellule du dessus est différente de "valeur" sinon on affiche ""

Je cherche mais je ne trouve pas le code
Avez vous une idée svp ?

Je vous joins un fichier "test"

 

[wDog66]

Bonjour,

Juste une question, pourquoi vouloir utiliser VBA alors qu'avec une formule on peut le faire 🤔

Sinon voici une possibilité

Sub CopieSansValeur()
  Dim dLig As Long, Lig As Long
  ' Avec la feuille du nom
  With Sheets("Feuil1")
    ' Dernière ligne du tableau
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour toutes les 1ère ligne par groupe de 2
    For Lig = 2 To dLig Step 2
      If .Range("D" & Lig) <> "Valeur" Then
        .Range("B" & Lig & ":F" & Lig).Copy Destination:=.Range("B" & Lig + 1)
      End If
    Next Lig
  End With
End Sub

A+

 

[Jacky67]

Bonjour à tous,

Je suis bloquée sur une macro VBA depuis ce matin :-(
Je cherche à copier/coller les lignes 2, 4 et 6 respectivement sur les lignes 3 5 et 7 si la valeur de la cellule du dessus est différente de "valeur" sinon on affiche ""

Je cherche mais je ne trouve pas le code
Avez vous une idée svp ?

Je vous joins un fichier "test"

Bonjour à tous
Autre possibilité par VBA avec la plage de saisie nommée "plage"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, [plage]) Is Nothing Then Exit Sub
    If Application.Match(Target, [liste], 0) > 4 Then Target.Offset(1) = "": Exit Sub
    Target.Offset(1) = Target
End Sub

 

[Fanouille]

Bonjour,

Juste une question, pourquoi vouloir utiliser VBA alors qu'avec une formule on peut le faire 🤔

Sinon voici une possibilité

Sub CopieSansValeur()
  Dim dLig As Long, Lig As Long
  ' Avec la feuille du nom
  With Sheets("Feuil1")
    ' Dernière ligne du tableau
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour toutes les 1ère ligne par groupe de 2
    For Lig = 2 To dLig Step 2
      If .Range("D" & Lig) <> "Valeur" Then
        .Range("B" & Lig & ":F" & Lig).Copy Destination:=.Range("B" & Lig + 1)
      End If
    Next Lig
  End With
End Sub

A+

Merci pour ce code mais je n'arrive pas à le transferer vers ma feuille

Pour répondre à la question : parceque je dois verrouiller toutes les formules pour respecter le data integrity

 

[Fanouille]

Bonjour à tous
Autre possibilité par VBA avec la plage de saisie nommée "plage"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, [plage]) Is Nothing Then Exit Sub
    If Application.Match(Target, [liste], 0) > 4 Then Target.Offset(1) = "": Exit Sub
    Target.Offset(1) = Target
End Sub

Merci pour ce code qui fonctionne sauf que lorsque je la transfert sur ma fiche excel elle actionne une macro que je nomme "résultat" et qui derrière verrouille et copie en integralité le fichier dans un nouveau fichier sans avoir executer les formules..

 

[Jacky67]

Merci pour ce code qui fonctionne sauf que lorsque je la transfert sur ma fiche excel elle actionne une macro que je nomme "résultat" et qui derrière verrouille et copie en integralité le fichier dans un nouveau fichier sans avoir executer les formules..

RE..
Dans le classeur présenté, il n'y a nullement de macro "résultat".
Il est impossible de voir ce qui se passe sans classeur réellement représentatif.
Donc........

 

[Fanouille]

C'est vai... du coup, voilà un fichier plus complet pour mieux comprendre

 

[Jacky67]

C'est vai... du coup, voilà un fichier plus complet pour mieux comprendre

Fichier .xls ?????
Les cellules concernées sont déverrouillées, elles n'auront donc pas d'influence sur une quelconque protection.
Je n'ai pas vérifié la macro "transfert_resultats()"

 

[Fanouille]

Fichier .xls ?????
Les cellules concernées sont déverrouillées, elles n'auront donc pas d'influence sur une quelconque protection.

c'est une simplification de mon fichier origine
Mon fichier origine est sous .xlsm

Lorsque je colle ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, [plage]) Is Nothing Then Exit Sub
If Application.Match(Target, [liste], 0) > 4 Then Target.Offset(1) = "": Exit Sub
Target.Offset(1) = Target
End Sub

Ma macro transfert se lance à la suite

 

[Jacky67]

c'est une simplification de mon fichier origine
Mon fichier origine est sous .xlsm

Lorsque je colle ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, [plage]) Is Nothing Then Exit Sub
If Application.Match(Target, [liste], 0) > 4 Then Target.Offset(1) = "": Exit Sub
Target.Offset(1) = Target
End Sub

Ma macro transfert se lance à la suite

Re..
Ce code est modifié dans le dernier classeur (.xls) transmit.
Car il n'y a plus de plage nommée "liste"
Dans mon code, il n'y a aucune instruction pour lancer la macro transfert