Macro archiver

Bonjour,

Je crée un model devis avec des données.

Certaines données doivent être archivées sur une autre feuille du même classeur.

J'ai pu créer une macro qui me transmet les données de mon devis sur la deuxième feuille. Seulement, à chaque fois que je veux ajouter des données, elles remplacent les données qu'il y avait avant.

Je voulais donc savoir comment faire pour faire comprendre à la macro qu'il faut ajouter les informations sur la ligne au dessus des informations qui existent déjà...

Par exemple, j'ai des informations sur la ligne 1... Et si je veux ajouter des autres données, j'aimerai que ca se rajoute à nouveau sur la ligne 1 et que l'ancienne ligne 1 apparaisse en ligne 2...

J'espère que j'ai été asez claire et que vous pourrez me répondre

Cordialement

Voila la macro

Sub gestiondevis()
'
' gestiondevis Macro
'

'
    Sheets("Devis Factures P1").Select
    Range("E7").Select
    Selection.Copy
    Sheets("Feuil1").Select
    Range("A4").Select
    ActiveSheet.Paste
    Sheets("Devis Factures P1").Select
    Range("E8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("B4").Select
    ActiveSheet.Paste
    Sheets("Devis Factures P1").Select
    Range("B12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("C4").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    Sheets("Devis Factures P1").Select
    Selection.Copy
    Sheets("Feuil1").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Devis Factures P1").Select
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 18
    Range("E47").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Devis Factures P1").Select
    Range("E48").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("E4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Devis Factures P1").Select
    Range("E49").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil1").Select
    Range("F4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

voila le fichier

Bonsoir

A essayer (pas la plus concise mais fonctionnelle)

Sub gestiondevis()
'
' gestiondevis Macro
'

Dim Lg As Long
' On est dans la page "Devis Factures P1"

  With Sheets("Feuil1")
    Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1     ' 1ère ligne vide

    .Range("A" & Lg).Value = CDate(Range("E7"))
    Range("E8").Copy Destination:=.Range("B" & Lg)
    Range("B12").Copy Destination:=.Range("C" & Lg)
    .Range("D" & Lg).Value = Range("E47")
    .Range("E" & Lg).Value = Range("E48")
    .Range("F" & Lg).Value = Range("E49")
  End With
End Sub

Banzai64 a écrit :

Bonsoir

A essayer (pas la plus concise mais fonctionnelle)

Sub gestiondevis()
'
' gestiondevis Macro
'

Dim Lg As Long
' On est dans la page "Devis Factures P1"

  With Sheets("Feuil1")
    Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1     ' 1ère ligne vide

    .Range("A" & Lg).Value = CDate(Range("E7"))
    Range("E8").Copy Destination:=.Range("B" & Lg)
    Range("B12").Copy Destination:=.Range("C" & Lg)
    .Range("D" & Lg).Value = Range("E47")
    .Range("E" & Lg).Value = Range("E48")
    .Range("F" & Lg).Value = Range("E49")
  End With
End Sub

Re bonjour "Banzai64"

Merci beaucoup pour la réponse

ça bug sur With Sheets("Feuil1")

Bonjour

Dans ton fichier as-tu une feuille qui s'appelle "Feuil1" ?

Quel message d'erreur d'erreur as-tu ?

Banzai64 a écrit :

Bonjour

Dans ton fichier as-tu une feuille qui s'appelle "Feuil1" ?

Quel message d'erreur d'erreur as-tu ?

Merci j'ai rechangé le nom de la feuille et ça fonctionne sauf sur

la colonne c le nom de client ça me met #N/A ou lieu de nom une autre chose si vous permettez archiver le nouveau devis toujours sur la première ligne

Merci

Bonjour

ait haddou a écrit :

a colonne c le nom de client ça me met #N/A ou lieu de nom

Tu as une formule pour récupérer le nom du client

ait haddou a écrit :

archiver le nouveau devis toujours sur la première ligne

Si elle est libre pas de problème

Efface tes archives et la prochaine facture sera archivée en ligne 3

Nouvelle macro

Sub gestiondevis()
'
' gestiondevis Macro
'

Dim Lg As Long
' On est dans la page "Devis Factures P1"

  With Sheets("Feuil1")
    Lg = .Range("A" & Rows.Count).End(xlUp).Row + 1     ' 1ère ligne vide
    .Range("A" & Lg).Resize(1, 6) = Array(CDate(Range("E7")), Range("E8"), Range("B12"), Range("E47"), Range("E48"), Range("E49"))
  End With
End Sub

Re bonjour

je supprime l'ancienne macro et j'affecte cette nouvelle macro ! merci de m’éclaircir c'est dur ça

Bonjour

ait haddou a écrit :

je supprime l'ancienne macro et j'affecte cette nouvelle macro ! merci de m’éclaircir c'est dur ça

Oui bien sur

Désolé de ne pas te l'avoir dit

Re bonjour

c'est pareil ,ça rien changé j'aimerai bien que chaque nouvelle facture soit au déçu de tableau par exemple

FA0003 nouvelle

FA0002

FA0001

MERCI

Bonjour

Nouvelle macro qui remplace l'autre

Sub gestiondevis()
'
' gestiondevis Macro
'

' On est dans la page "Devis Factures P1"

  With Sheets("Feuil1")
    .Range("A3:F3").Insert shift:=xlShiftDown
    .Range("A3:F3").Value = Array(CDate(Range("E7")), Range("E8"), Range("B12"), Range("E47"), Range("E48"), Range("E49"))
    .Range("A3:F3").Interior.ColorIndex = xlNone
  End With
End Sub

Merci beaucoup MR Banzai64

c'est réglé