XL 2019 Macro copier /coller une ligne dans un tableau (du menu insertion/tableau)

[micsel]

Bonjour,
Cela fait plusieurs heures que j'ai beau essayé de finaliser cette petite macro. (ps je me sers de l'enregistrement de macro, et j'essai d'ajuster)
l'idée est de copier coller des valeurs dans ce tableau en ajout a la ligne a chaque fois.
Voila le petit code :

Sub rea_destock()
'
' rea_destock Macro
'

'
    Sheets("S").Range("A2:G2").Select
    Selection.Copy
    Sheets("J").Select
    Range("journal[Date]").End(xlDown).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("S").Select
    Range("B4").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B6").Select
    Selection.ClearContents
    Range("B8").Select
    Selection.ClearContents
    Range("D8:E8").Select
    Selection.ClearContents
End Sub

Merci d'avance pour votre compassion à mon égard et de vos réponses.

 

[Bernard_XLD]

Bonjour Micsel, le forum

Voila ton code reécrit, pas testé sans fichier et tu as une plage nommée (je ne sais pas à quoi elle correspond)
les sélections sont inutiles et ne font que ralentir
pas besoin de passer par copy pour transférer des valeurs
les opérations d'effacement peuvent être faite en multi sélection

Bien cordialement

Sub rea_destock()
'
' rea_destock Macro
'

'
    Sheets("J").Range("journal[Date]").End(xlDown).Offset(1, 0).Range("A1:G1").Value = Sheets("S").Range("A2:G2").Value
    Sheets("S").Range("B4,B6,B8,D8:E8").ClearContents
End Sub

 

[micsel]

Les selections sont du fait que je ne sais "presque" me servir de l'enregistreur de macro.

Le code ne fonctionne pas

(je te joins le fichier au cas ou)

 

[soan]

Bonjour micsel, Yeahou,

un essai :

Sub rea_destock()
  If ActiveSheet.Name <> "S" Then Exit Sub
  Dim cel As Range: Application.ScreenUpdating = 0
  With Worksheets("J")
    Set cel = .Cells(.ListObjects("journal").ListRows.Count + 1, 1)
    [A2:G2].Copy: cel.PasteSpecial -4163: cel.Offset(, 7) = [B4]
    cel.Offset(, 8) = [B6]: cel.Offset(, 9) = [B8]
    [D8:E8].Copy: cel.Offset(, 10).PasteSpecial -4163
  End With
  [B4, B6, B8, D8:E8].ClearContents
  Application.CutCopyMode = 0
End Sub

soan

 

[micsel]

@soan,
ton code enlève le titre du tableau

 

[soan]

@micsel

sans fichier, c'était pas évident ; voici ton fichier en retour.

* tu es sur la feuille "J", et tu peux voir que la ligne 2 est vide

* va sur la feuille "S", et fais Ctrl e ➯ travail effectué !

Sub rea_destock()
  If ActiveSheet.Name <> "S" Then Exit Sub
  Application.ScreenUpdating = 0: [A2:G2].Copy
  With Worksheets("J")
    .Cells(.ListObjects("journal").ListRows.Count + 2, 1).PasteSpecial -4163
    [B4, B6, B8, D8:E8].ClearContents: Application.CutCopyMode = 0: .Select
  End With
End Sub

soan

 

[micsel]

mais c'est génial
maintenant je regarde le code, puisque j'arrivais a le faire (en enregistreur de données) sans "tableau"

Merci beaucoup

 

[micsel]

ah pourquoi -4163 ?
j'ai compris le reste mais pas ca

 

[soan]

@micsel

-4163 est la constante numérique de xlPasteValues ;
c'est plus court à écrire et à lire.

soan

 

[micsel]

ok, donc je me note bien cette information

Merci