Microsoft 365 Remplacer cellule par d'autres en macro

sylvanu à dit:

Bonjour Saggigo,
Essayez :

VB:

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

Cliquez pour agrandir...

Dranreb à dit:

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 :

VB:

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

Cliquez pour agrandir...

sylvanu à dit:

Bonsoir,

VB:

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

Cliquez pour agrandir...

saggigo à dit:

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

Cliquez pour agrandir...

If Condition Then
   Action
End If