Microsoft 365 copier des cellules sous conditions

Usine à gaz · 11 Janvier 2021

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

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

fanfan38 · 11 Janvier 2021

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 · 11 Janvier 2021

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

Usine à gaz · 11 Janvier 2021

Bonjour fanfan38,
Merci pour la réponse
Je teste dès que j'ai un moment et je reviens.
lionel,

Usine à gaz · 11 Janvier 2021

Re-Bjr fanfan38,

Test réussi, ça fonctionne nickel.
Un grand merci
lionel,

Microsoft 365 copier des cellules sous conditions

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

fanfan38

fanfan38

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Usine à gaz

XLDnaute Barbatruc

Discussions similaires