Macro pour copier-coller cellule ("D3:H3") en ("D7") si vide

Bonjour,

Je débute en "VBA " macro et donc demande de l'aide pour avancer.

Voici mes données ou du moins ce que je souhaite réaliser à partir d'une macro (Bouton) contenue dans une feuille de classeur.

A l'aide déjà de vos enseignements, pour l'instant j'ai dans une macro qui fonctionne :

Private Sub Feuil1_Click()

Range ("D3:H3") .Copy Range ("D7") ' Copie cellule D3 à D7 & colle dans D7

Range ("E3,F3,H3") . Select ' Selection E3,F3,H3 pour clear (pas D3 et G3 pour garder condition)

Selection. Clear

End SuB

Mais, je voudrais ajouter une condition de Copie dans ("D7") si D7 est vide, sinon décaler cellule du bas ex: D8 sachant qu'il y a 25 lignes de dispo dans la feuille afin d'archiver les données, ensuite si D32 est plein "Alerte" stop macro

Dans la "foulée" je voudrais enregistrer dans son propre dossier le classeur ouvert et fermer celui-ci toujours dans la même macro, sans fermer Excel car autre classeur ouvert.

Merci pour votre compréhension

Bonjour et bienvenue sur le forum

Un essai à tester. Te convient-il ?

Bye !

Option Explicit

Dim lgn&

Sub ess()

    lgn = 7
    While Range("D" & lgn) <> ""
        lgn = lgn + 1
    Wend
    If lgn <= 31 Then
        Range("D3:H3").Copy Range("D" & lgn)   ' Copie cellule D3 à D7 & colle dans D7
    Else
        MsgBox "Tableau plein. Impossible de faire la copie."
    End If
    ActiveWorkbook.Close True

End Sub

Merci gmd pour avoir consulté ma demande et donné une réponse à tester.

Mais comme je ne connais pas vba, je tâtonne et plus encore- par petit bout.

Donc voici ce que j'ai introduit et là j'ai besoin de conseils avérés.

(Macro)

Private Sub Feuil1_Click()

If Range("H3") > "" Then ' Condition H3 Rendu

MsgBox ("On Enregistre Suivi")

Else

MsgBox ("ATTENTION Pas Rendu")

Exit Sub

End If

End Sub ' Ceci fonctionne

'Option Explicit que j'ai introduit pour le test, est-ce que c'est ainsi ?

Option Explicit

Dim lgn&

Sub ess()

ign = 7

While Range("d" & lgn) <> ""

lgn = lgn + 1

Wend

If lgn <= 20 Then

Range("D3:H3").Copy Range("D" & lgn) 'Copy D3 a H7 dans D7

Else

MsgBox "Tableau plein"

End If

ActiveWorkbook.Close

End Sub ' La suite permet d'effacer les données suivantes et enregistrer

Range("E3,F3,H3").Select ' Sélection E3,F3,H3 pour Clear (pas D3 et G3 pour garder condition)

Selection.Clear

MsgBox "Effacement OK Continuer"

Dim Fichier As String

Fichier = "C:\Dossiers\Inventaire FRM.xlsm"

ThisWorkbook.SaveAs

End Sub

Pour voir les macros : Alt et F11

Bye !

Merci pour le test de ta macro (je tutoie). Je devrais reprendre des cours....

Mais j'aimerai pouvoir l'introduire après le test de "H3" que je vérifie au départ et donc que tu puisses me diriger ou si tu veux bien me "mâcher" le travail. Merci pour ta compréhension.

Voici ce que j'ai inséré (ta macro), mais qui bloque ensuite faute de maitrise de ma part.

Private Sub Feuil1_Click()

If Range("H3") > "" Then ' Condition H3 Rendu

MsgBox ("On Enregistre Suivi")

Else

MsgBox ("ATTENTION Pas Rendu")

Exit Sub

End If

'Option Explicit

Dim lgn&

Sub Copier()

lgn = 7

While Range("D" & lgn) <> ""

lgn = lgn + 1

Wend

If lgn <= 31 Then

Range("D3:H3").Copy Range("D" & lgn) ' Copie cellule D3 à D7 & colle dans D7

Else

MsgBox "Tableau plein. Impossible de faire la copie."

End If

Range("E3,F3,H3").ClearContents

MsgBox ("OK")

ActiveWorkbook.Close True

End Sub

' en attente d'enregistrement dans son dossier

Dim Fichier As String

Fichier = "C:\Dossiers\Inventaire FRM.xlsm"

ThisWorkbook.SaveAs

End Sub

Mauvaise manip.voir message suivant

Bonjour

Nanar40 a écrit :

j'aimerai pouvoir l'introduire après le test de "H3" que je vérifie au départ

...
If Range("H3") > "" Then 
   Call Copier
...

Bye

Merci pour ton aide. Bon déconfinement.