Enregistrer les détails d'une facture dans une autre feuille avec VBA

Bonjour à tous,

J'aurais besoin d'aide dans cette situation:

J'ai une feuille "Opération", je souhaiterais utiliser une touche pour enregistrer les détails de toute l'opération dans une autre feuille "detail".

Voici ce que j'ai pu réaliser pour l'instant, mais le code bloque, et je ne comprend pas mon erreur:

Sub Archiver()
For Each Item In Sheets("Operation").Range("B19:B27")
If Item.Value = "" Then
'ne rien faire
Else
'archiver le contenu de la ligne
ligne = Sheets("Detail").Select
             Rows("2:2").Select
             Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ligne_origine = Item.Row
Sheets("Detail").Range("A" & ligne).Value = Sheets("Operation").Range("E4").Value
Sheets("Detail").Range("B" & ligne).Value = Sheets("Operation").Range("H4").Value
Sheets("Detail").Range("C" & ligne).Value = Sheets("Operation").Range("C6").Value
Sheets("Detail").Range("D" & ligne).Value = Sheets("Operation").Range("C12").Value
Sheets("Detail").Range("E" & ligne).Value = Sheets("Operation").Range("H6").Value

Sheets("Detail").Range("F" & ligne).Value = Sheets("Operation").Range("B" & ligne_origine).Value
Sheets("Detail").Range("G" & ligne).Value = Sheets("Operation").Range("C" & ligne_origine).Value
Sheets("Detail").Range("H" & ligne).Value = Sheets("Operation").Range("I" & ligne_origine).Value

End If

End Sub

PS: Je suis sous Excel Mac de 2020.

Je sais qu'il peut y avoir quelque modification avec la version Classic.

Merci pour votre aide,

Cordialement,

QR

Bonjour Rquantin, bonjour le forum,

je ne connais Excel sous Mac mais il me semble que ton code comporte quelques erreurs
Item est un mot clé Visual Basic, donc à éviter en tant que variable.

Essaie comme ça :

Sub Archiver()
Dim O As Worksheet
Dim D As Worksheet
Dim CEL As Range
Dim ligne As Integer
Dim ligne_origine As Integer

Set O = worksheets("Operation")
Set D = worksheets("Details")
For Each CEL In O.Range("B19:B27")
    If CEL.Value <> "" Then
        ligne = D.Cells(Application.Rows.Count, "A").End(xlUp).Row
        ligne_origine = CEL.Row
        D.Range("A" & ligne).Value = O.Range("E4").Value
        D.Range("B" & ligne).Value = O.Range("H4").Value
        D.Range("C" & ligne).Value = O.Range("C6").Value
        D.Range("D" & ligne).Value = O.Range("C12").Value
        D.Range("E" & ligne).Value = O.Range("H6").Value
        D.Range("F" & ligne).Value = O.Range("B" & ligne_origine).Value
        D.Range("G" & ligne).Value = O.Range("C" & ligne_origine).Value
        D.Range("H" & ligne).Value = O.Range("I" & ligne_origine).Value
    End If
Next CEL
End Sub

Bonjour ThauThème,

Merci beaucoup pour ton retour.

Je viens de le coller dans mon classeur. Cependant, je rencontre un problème.

L'action s'effectue correctement, cependant, il faudrait que je puisse transférer toutes les écriture dans l'onglet détail, et malheurement une seule ligne ce transfert.

Je te joint un fichier pour comprendre.

Merci

@+

RQ

Re,

oui la variable ligne n'était pas actualisée dans la boucle...

Sub Archiver()
Dim O As Worksheet
Dim D As Worksheet
Dim CEL As Range
Dim ligne As Integer
Dim ligne_origine As Integer

Set O = Worksheets("Operation")
Set D = Worksheets("Detail")
For Each CEL In O.Range("B19:B27")
    If CEL.Value <> "" Then
        ligne = IIf(D.Range("A2").Value = "", 2, D.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1)
        ligne_origine = CEL.Row
        D.Range("A" & ligne).Value = O.Range("E4").Value
        D.Range("B" & ligne).Value = O.Range("H4").Value
        D.Range("C" & ligne).Value = O.Range("C6").Value
        D.Range("D" & ligne).Value = O.Range("C12").Value
        D.Range("E" & ligne).Value = O.Range("H6").Value
        D.Range("F" & ligne).Value = O.Range("B" & ligne_origine).Value
        D.Range("G" & ligne).Value = O.Range("C" & ligne_origine).Value
        D.Range("H" & ligne).Value = O.Range("I" & ligne_origine).Value
    End If
Next CEL
'vider les champs
'Sheets("Operation").Range("E4;H4;C6;H6;C12;B19:B27;B32:B40G19:G27;G32:G40").ClearContents
End Sub

Re,

C'est nickel merci beaucoup !

J'aurais une autre question:

C'est concernant le ClearContent, j'utilise le code :

Sheets("Operation").Range("E4").ClearContents

mais ça me fais une erreur, alors j'ai modifié:

Set O = Worksheets("Operation")
O.Range("E4,H4,C6,H6").ClearContents

mais j'ai toujours une erreur ! Je ne comprend pas pourquoi ?!

Merci si tu as une idée,

@+

RQ

Re,

VBA et les cellules fusionnées ne font pas bon ménage. Des point-virgule ; au lieu de virgules , :

O.Range("E4,H4:I4,C6:E6,H6:I6,C12:D12,B19:B27,B32:B40,G19:H27,G32:H40").ClearContents

la formule dans I32 :

=(SI(H32="";"";(H32*G32)*-1))

Re,

Nikel c'est super tout fonctionne bien !

Merci beaucoup !

@+

RQ