Microsoft 365 Remplacer cellule par d'autres en macro

[saggigo]

Bonjour à tous chère communauté,
Voila j'ai une feuille excel et je souhaite ajouter un bouton qui permet de mettre une valeur d'une cellule X si la première cellule est vite

donc pour faire plus dans le détail, j'ai mis un fichier excel test en pièce jointe, et j'aimerais que mon bouton test :
- Si les valeurs en colonne D sont différentes de "" alors remplacer le contenu de la colonne A par D juste pour les cellules non vides
- Si les valeurs en colonne E et G sont vides, prendre les valeurs respectives des colonnes M et N et les mettre dans E et G.

Merci beaucoup pour votre aide

 

[sylvanu]

Bonjour Saggigo,
Essayez :

Sub Remplace()
    Application.ScreenUpdating = False: Dim L%
    For L = 2 To Range("C65500").End(xlUp).Row  ' Jusqu'à dernire ligne de C
        ' Si D non vide et A vide alors A=D
        If Cells(L, "D") <> "" And Cells(L, "A") = "" Then Cells(L, "A") = Cells(L, "D")
        ' Si M non vide et E vide alors E=M
        If Cells(L, "M") <> "" And Cells(L, "E") = "" Then Cells(L, "E") = Cells(L, "M")
        ' Si N non vide et G vide alors G=N
        If Cells(L, "N") <> "" And Cells(L, "G") = "" Then Cells(L, "G") = Cells(L, "N")
    Next L
    Application.ScreenUpdating = True
End Sub

 

[Dranreb]

Bonjour.
En supposant qu'après transfert les cellules source doivent être effacées pour ne pas rester identiques en deux places désignées différemment, je l'écrirais comme ça :

Sub Actualiser()
   Dim Rng As Range, T(), L As Long
   Set Rng = Feuil1.UsedRange
   Set Rng = Rng.Rows(2).Resize(Rng.Rows.Count - 1)
   T = Rng.Value
   For L = 1 To UBound(T, 1)
      If T(L, 4) <> "" Then
         T(L, 1) = T(L, 4)
         T(L, 4) = Empty
         End If
      If IsEmpty(T(L, 5)) And IsEmpty(T(L, 7)) Then
         T(L, 5) = T(L, 13)
         T(L, 7) = T(L, 14)
         T(L, 13) = Empty: T(L, 14) = Empty
         End If
      Next L
   Rng.Value = T
   End Sub

 

[saggigo]

Bonjour Saggigo,
Essayez :

Sub Remplace()
    Application.ScreenUpdating = False: Dim L%
    For L = 2 To Range("C65500").End(xlUp).Row  ' Jusqu'à dernire ligne de C
        ' Si D non vide et A vide alors A=D
        If Cells(L, "D") <> "" And Cells(L, "A") = "" Then Cells(L, "A") = Cells(L, "D")
        ' Si M non vide et E vide alors E=M
        If Cells(L, "M") <> "" And Cells(L, "E") = "" Then Cells(L, "E") = Cells(L, "M")
        ' Si N non vide et G vide alors G=N
        If Cells(L, "N") <> "" And Cells(L, "G") = "" Then Cells(L, "G") = Cells(L, "N")
    Next L
    Application.ScreenUpdating = True
End Sub

Bonjour Sylvanu,
Je te remercie pour le support, j'aime bien ton code qui est très explicite, peux-tu s'il te plait quel code ajouter pour vider les cellule copiées? j'aimerais vider: D; M; N

Merci beaucoup

 

[saggigo]

Bonjour.
En supposant qu'après transfert les cellules source doivent être effacées pour ne pas rester identiques en deux places désignées différemment, je l'écrirais comme ça :

Sub Actualiser()
   Dim Rng As Range, T(), L As Long
   Set Rng = Feuil1.UsedRange
   Set Rng = Rng.Rows(2).Resize(Rng.Rows.Count - 1)
   T = Rng.Value
   For L = 1 To UBound(T, 1)
      If T(L, 4) <> "" Then
         T(L, 1) = T(L, 4)
         T(L, 4) = Empty
         End If
      If IsEmpty(T(L, 5)) And IsEmpty(T(L, 7)) Then
         T(L, 5) = T(L, 13)
         T(L, 7) = T(L, 14)
         T(L, 13) = Empty: T(L, 14) = Empty
         End If
      Next L
   Rng.Value = T
   End Sub

Bonjour Dranreb,
Je te remercie pour ton support, mais j'ai pas su comment l'adapter si je veux changer de colonne.

Merci encore

 

[sylvanu]

Bonsoir,

Sub Remplace()
    Application.ScreenUpdating = False: Dim L%
    For L = 2 To Range("C65500").End(xlUp).Row  ' Jusqu'à dernire ligne de C
        ' Si D non vide et A vide alors A=D, et D vide
        If Cells(L, "D") <> "" And Cells(L, "A") = "" Then
            Cells(L, "A") = Cells(L, "D")
            Cells(L, "D") = ""
        End If
        ' Si M non vide et E vide alors E=M, et M vide
        If Cells(L, "M") <> "" And Cells(L, "E") = "" Then
            Cells(L, "E") = Cells(L, "M")
            Cells(L, "M") = ""
        End If
        ' Si N non vide et G vide alors G=N, et N vide
        If Cells(L, "N") <> "" And Cells(L, "G") = "" Then
            Cells(L, "G") = Cells(L, "N")
            Cells(L, "N") = ""
        End If
    Next L
    Application.ScreenUpdating = True
End Sub

 

[Dranreb]

C'est le numéro de colonne derrière 'T(L, ' qui est à adapter

 

[saggigo]

Bonsoir,

Sub Remplace()
    Application.ScreenUpdating = False: Dim L%
    For L = 2 To Range("C65500").End(xlUp).Row  ' Jusqu'à dernire ligne de C
        ' Si D non vide et A vide alors A=D, et D vide
        If Cells(L, "D") <> "" And Cells(L, "A") = "" Then
            Cells(L, "A") = Cells(L, "D")
            Cells(L, "D") = ""
        End If
        ' Si M non vide et E vide alors E=M, et M vide
        If Cells(L, "M") <> "" And Cells(L, "E") = "" Then
            Cells(L, "E") = Cells(L, "M")
            Cells(L, "M") = ""
        End If
        ' Si N non vide et G vide alors G=N, et N vide
        If Cells(L, "N") <> "" And Cells(L, "G") = "" Then
            Cells(L, "G") = Cells(L, "N")
            Cells(L, "N") = ""
        End If
    Next L
    Application.ScreenUpdating = True
End Sub

Parfait je suis super content, merci beaucoup Sylvanu. merci.
Sauf que j'ai du enlever les end if car j'avais un message d'erreur.

 

[sylvanu]

j'ai du enlever les end if car j'avais un message d'erreur

S'il n'y a pas les End If, alors il y aura erreur.
L'erreur venait d'autre part, car la structure est toujours :

If Condition Then
   Action
End If