Microsoft 365 copier des cellules sous conditions

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,
Je vous souhaite une belle journée :)

Je fais appel à nouveau à nos ténors préférés car, malgré mes recherches et tests, je n'arrive pas à coder pour réaliser mon besoin :
Vous le verrez dans le fichier test joint

si la cellule "C19" est égale à "libre" et la cellule "D19" est vide,
alors copier les cellules "A19 à "C19 sous la 1ère ligne vide "de la Colonne E"
en cellules "Colonnes A à C"

Important : il peut y avoir bcp plus de cellule NON VIDES en colonne E
.........................et bcp plus de cellules à déplacer en en colonnes A à C

J'avais aussi pensé aux boucles mais il y a 2 conditions et je n'y arrive pas :mad:

Auriez-vous la solution ?
Un grand merci déjà pour m'avoir lu.
Amicalement,
lionel,
 

Pièces jointes

  • test2.xlsm
    45.8 KB · Affichages: 23
Solution
Bonjour et bonne année
ci dessous la macro à utiliser

VB:
Sub action()
  Dim i As Long, dl As Long, lig As Long
  dl = Range("E" & Rows.Count).End(xlUp).Row
  lig = dl + 1
  For i = 3 To dl
    If Range("C" & i).Value = "libre" And Range("D" & i) = "" Then
      Range(Cells(i, "A"), Cells(i, "D")).Copy Destination:=Range("A" & lig)
      Range(Cells(i, "A"), Cells(i, "D")).ClearContents
      lig = lig + 1
    End If
  Next
End Sub

A+ François

fanfan38

XLDnaute Barbatruc
Bonjour et bonne année
ci dessous la macro à utiliser

VB:
Sub action()
  Dim i As Long, dl As Long, lig As Long
  dl = Range("E" & Rows.Count).End(xlUp).Row
  lig = dl + 1
  For i = 3 To dl
    If Range("C" & i).Value = "libre" And Range("D" & i) = "" Then
      Range(Cells(i, "A"), Cells(i, "D")).Copy Destination:=Range("A" & lig)
      Range(Cells(i, "A"), Cells(i, "D")).ClearContents
      lig = lig + 1
    End If
  Next
End Sub

A+ François
 

Discussions similaires

Statistiques des forums

Discussions
312 165
Messages
2 085 880
Membres
103 009
dernier inscrit
dede972