Demande d'aide pour creation d'une macro de recopie incrementé

stf4

XLDnaute Nouveau
Bonjour,


Voila je débute en macro sous excel et je recherche quelqu'un qui pourrai prendre un peu de temps pour
cree un bout de code qui me permeterai de copier des informations dans une feuille sur une autre de facon a incrementé une nouvelle ligne a chaque fois via un bouton ,voir le fichier ci joint.

merci de votre aides

BD
 

Pièces jointes

  • test.xls
    27 KB · Affichages: 42
  • test.xls
    27 KB · Affichages: 43
  • test.xls
    27 KB · Affichages: 46
Dernière édition:

Fred0o

XLDnaute Barbatruc
Re : Demande d'aide pour creation d'une macro de recopie incrementé

Bonjour Stf4 et bienvenue sur le forum.

Voici un code qui fonctionne :
VB:
Sub Recopie()
    Dim dl As Long
    dl = Sheets("liste").[A65536].End(xlUp).Row
    [A3:U3].Copy Destination:=Sheets("liste").Cells(dl + 1, 1)
End Sub

Si tu veux en plus que la macro efface les données de la feuille Saisie une fois la ligne copiée, il te suffit de rajouter ceci juste avant le "End Sub" :
VB:
[A3:U3].ClearContents

Si maintenant tu veux être sûr de ne pas recopier des lignes vides pour rien, ton code peut devenir ceci :
VB:
Sub Recopie()
    Dim dl As Long
    dl = Sheets("liste").[A65536].End(xlUp).Row
    If WorksheetFunction.CountA([A3:U3]) > 0 Then
        [A3:U3].Copy Destination:=Sheets("liste").Cells(dl + 1, 1)
        [A3:U3].ClearContents
    Else
        MsgBox "Ligne vide non recopiée"
    End If
End Sub

A+
 

stf4

XLDnaute Nouveau
Re : Demande d'aide pour creation d'une macro de recopie incrementé

Bonjour Stf4 et bienvenue sur le forum.

Voici un code qui fonctionne :
VB:
Sub Recopie()
    Dim dl As Long
    dl = Sheets("liste").[A65536].End(xlUp).Row
    [A3:U3].Copy Destination:=Sheets("liste").Cells(dl + 1, 1)
End Sub

Si tu veux en plus que la macro efface les données de la feuille Saisie une fois la ligne copiée, il te suffit de rajouter ceci juste avant le "End Sub" :
VB:
[A3:U3].ClearContents

Si maintenant tu veux être sûr de ne pas recopier des lignes vides pour rien, ton code peut devenir ceci :
VB:
Sub Recopie()
    Dim dl As Long
    dl = Sheets("liste").[A65536].End(xlUp).Row
    If WorksheetFunction.CountA([A3:U3]) > 0 Then
        [A3:U3].Copy Destination:=Sheets("liste").Cells(dl + 1, 1)
        [A3:U3].ClearContents
    Else
        MsgBox "Ligne vide non recopiée"
    End If
End Sub

A+


Bonjour,

Voila votre code fonctionne ,mais pa tout a fait comme je le souhaiterai ,je m'explique:

les données apparaisse bien dans la feuille liste mais avec le format formule et valeur ,alors que je ne souhaite que les valeurs et j'aimerai que seul les valeurs soient effacer dans la feuille Saisie pas les formules.
J'arrivais a cela en faisant un copier et un collage spéciale avec uniquement les valeurs. Peut on l'intégré a votre code ?

J'espere etre clair dans mes explications , merci encore de votre aides.

BD
 
Dernière édition:

Fred0o

XLDnaute Barbatruc
Re : Demande d'aide pour creation d'une macro de recopie incrementé

Bonjour stf4,

Voila votre code fonctionne ,mais pa tout a fait comme je le souhaiterai ,je m'explique:

les données apparaisse bien dans la feuille liste mais avec le format formule et valeur ,alors que je ne souhaite que les valeurs et j'aimerai que seul les valeurs soient effacer dans la feuille Saisie pas les formules.
J'arrivais a cela en faisant un copier et un collage spéciale avec uniquement les valeurs. Peut on l'intégré a votre code ?

Cela n'est pas étonnant, car tu n'avait pas demandé ces précisions sur les formules et le format :

cree un bout de code qui me permeterai de copier des informations dans une feuille sur une autre de facon a incrementé une nouvelle ligne a chaque fois via un bouton ,voir le fichier ci joint.

D'autant plus qu'il n'y a aucune formule dans ton fichier, je ne pouvais pas le deviner !!!

Essaie donc ceci :
VB:
Sub Recopie()
    Dim dl As Long, c As Byte
    dl = Sheets("liste").[A65536].End(xlUp).Row
    If WorksheetFunction.CountA([A3:U3]) > 0 Then
        For c = 1 To 21
            Sheets("liste").Cells(dl + 1, c).Value = Cells(3, c)
            If Not Left(Cells(3, c).Formula, 1) = "=" Then Cells(3, c).ClearContents
        Next
    Else
        MsgBox "Ligne vide non recopiée"
    End If
End Sub

A+
 

Fred0o

XLDnaute Barbatruc
Re : Demande d'aide pour creation d'une macro de recopie incrementé

Re-bonsoir,

voici la macro modifiée.

J'ai mis la fonction d'effacement en commentaire. A toi de voir si tu veux l'activer ou pas.
VB:
Sub Recopie()
    Dim dl As Long, c As Byte
    dl = Sheets("Feuil1").[A65536].End(xlUp).Row
    If dl = 5 Then dl = 6
    If WorksheetFunction.CountA(Sheets("Saisie").[A19:U19]) > 0 Then
        For c = 1 To 21
            Sheets("Feuil1").Cells(dl + 1, c).Value = Sheets("Saisie").Cells(19, c)
'            If Not Left(Cells(19, c).Formula, 1) = "=" Then Cells(19, c).ClearContents
        Next
    Else
        MsgBox "Ligne vide non recopiée"
    End If
End Sub

A+
 

stf4

XLDnaute Nouveau
Re : Demande d'aide pour creation d'une macro de recopie incrementé

Fred,

T'es trop fort ton code de recopie marche nickel , a un détail prés quand j'active la fonction d'effacement de la ligne sur la feuille saisie en ligne 19 seul la cellule B19 s'efface le reste de la ligne reste en place !

Une idée sur le probleme ?

Encore mille merci de ton aides !


Re-bonsoir,

voici la macro modifiée.

J'ai mis la fonction d'effacement en commentaire. A toi de voir si tu veux l'activer ou pas.
VB:
Sub Recopie()
    Dim dl As Long, c As Byte
    dl = Sheets("Feuil1").[A65536].End(xlUp).Row
    If dl = 5 Then dl = 6
    If WorksheetFunction.CountA(Sheets("Saisie").[A19:U19]) > 0 Then
        For c = 1 To 21
            Sheets("Feuil1").Cells(dl + 1, c).Value = Sheets("Saisie").Cells(19, c)
'            If Not Left(Cells(19, c).Formula, 1) = "=" Then Cells(19, c).ClearContents
        Next
    Else
        MsgBox "Ligne vide non recopiée"
    End If
End Sub

A+
 

stf4

XLDnaute Nouveau
Re : Demande d'aide pour creation d'une macro de recopie incrementé

Bonjour

Merci de de ta réponse et de ton aides précieuse, j'ai du mal m'exprimer ,voila j'aimerai que la ligne efface les valeurs présente dans chacune des cellules ,sans supprimer les formules présentes dans celle ci une fois le code exécuté.

Merci a toi .
 

Discussions similaires