VBA - Copier/Coller ligne

Bonjour,

Quelqu'un pourrait-il m'aider à modifier ce code pour une action précise qui serait déclenchée au clic d'un bouton?

Je souhaiterais copier la ligne 13 puis la coller après la dernière ligne contenant des données et en gardant le format d'origine.

A chaque clic du bouton, la macro devra répéter l'action.

Ex : Si la dernière ligne non vide est la ligne 32 --> copie de la ligne 13 à la ligne 33

Sub Ajout_Ligne()
Rows("13:13").Select
Selection.EntireRow.Copy
Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Select
ActiveSheet.Paste
ActiveCell = Now
Application.CutCopyMode = False
End Sub

Merci de votre aide

Bonsoir Eli,

Il te suffit de supprimer cette ligne de code : 'ActiveCell = Now

La macro une fois modifiée recopiera la ligne 12 à la suite de la dernière ligne en gardant la mise en forme.

Cordialement.

Bonsoir Zebulon,

Je viens de tester et çà fonctionne pas

J'ai mis un fichier pour que tu vois.

re,

C'est normal, la macro ne fonctionne que s'il y a une valeur dans la colonne A de la ligne nouvellement crée. Saisis n'importe quoi dans la colonne A et lance la macro.

Cordialement.

Effectivement, tu as raison

Peut-on mettre un contrôle du type si une donnée est saisie dans l'une des colonnes allant de A à D, que la ligne ne soit pas copiée.

Car par exemple, si une valeur est saisie dans dans la colonne B, la copie remplace toute la ligne.

Il faudrait un message box du genre "Merci de remplir toute la ligne avant d'en ajouter une autre"

En gros, ce que j'aimerais, c'est obliger l'utilisateur à remplir toutes les colonnes de A à D avant de pouvoir ajouter une nouvelle ligne.

Re,

Une proposition à finaliser, la macro ne fonctionne pas correctement sur la vérification des cellules vides.

Cordialement.

Oups !

Tu as oublié le fichier

Saltut tout le monde,

un essai

Bonsoir m3ellem1 !

Merci beaucoup pour ton aide

Je viens de tester ta proposition - C'est super

Sauf que si on remplit uniquement la colonne A, la copie se fait tout de même

J'aimerais que la copie se fasse à condition que toutes les colonnes de A à D soient remplies

Comment faire?

Re,

essaie cette macro

Sub Ajout_Ligne()
Dim x As Long
x = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
If WorksheetFunction.CountA(Range("A" & x & ":D" & x)) < 4 Then
    MsgBox ("Merci de remplir toute la ligne avant d'en ajouter une autre")
Else
    Rows("13:13").EntireRow.Copy
    Range("A" & x + 1).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End If
End Sub

C'est excellent - Le code fonctionne parfaitement

Je viens de l'adapter à mon fichier final.

Merci beaucoup pour ton aide

Eli a écrit :

C'est excellent - Le code fonctionne parfaitement

Je viens de l'adapter à mon fichier final.

Merci beaucoup pour ton aide

Mais avec plaisir

Re

oups ! désolé.

Par contre comme indiqué dans mon précédent message. Si la colonne A n'est pas renseignée les valeurs saisie dans la dernière ligne sont écrasées.

Re,

Je vois que m3ellem1 a trouvé la solution, chapeau bas.

Bonne soirée.

Merci Zebulon

Cà fonctionne très bien

Comment pourrait-on forcer la saisie en majuscule dans les colonnes B et C pour toutes les nouvelles lignes ajoutées?

Trouvé sur le net :

'www.excel-downloads.com/threads/forcer-lecriture-cellule-en-majuscule.84800/
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect([A2:d200], Target) Is Nothing And Target.Count = 1 Then Target = UCase(Target)
Application.EnableEvents = True
End Sub

Cordialement.

Merci

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect([b2:c200], Target) Is Nothing And Target.Count = 1 Then Target = UCase(Target)
Application.EnableEvents = True
End Sub

Bonjour,

Je relance ce sujet car j'avais mal exprimé ma demande

Dans cette macro que m'a proposé m3ellem1 et aussi celle de Zebulon, je souhaite que la vérification se fasse à compter de la ligne 23. Les lignes de 1 à 22 ne doivent être comprises dans cette vérification.

Quelqu'un pourrait-il m'aider à revoir le code , svp?

Sub Ajout_Ligne()
Dim x As Long
x = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
If WorksheetFunction.CountA(Range("A" & x & ":D" & x)) < 4 Then
    MsgBox ("Merci de remplir toute la ligne avant d'en ajouter une autre")
Else
    Rows("13:13").EntireRow.Copy
    Range("A" & x + 1).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
End If
End Sub

double poste

Sub Ajout_Ligne()
Dim x As Long
x = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
If WorksheetFunction.CountA(Range("B" & x & ":E" & x)) < 4 Then
    MsgBox ("Merci de remplir toutes les informations relatives à l'ayant droit avant d'en ajouter un autre")
Else
    Rows("13:13").EntireRow.Copy
    If x > 22 Then
    Range("A" & x + 1).PasteSpecial xlPasteAll
    Else
    x = 22
    Range("A" & x + 1).PasteSpecial xlPasteAll
    End If
    Application.CutCopyMode = False
End If
End Sub