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

micsel · 9 Mars 2021

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 :

VB:

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 · 9 Mars 2021

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

VB:

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 · 9 Mars 2021

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 · 9 Mars 2021

Bonjour micsel, Yeahou,

un essai :

VB:

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 · 9 Mars 2021

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

soan · 9 Mars 2021

@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é !

VB:

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 · 9 Mars 2021

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 · 9 Mars 2021

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

soan · 9 Mars 2021

@micsel

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

soan

micsel · 9 Mars 2021

ok, donc je me note bien cette information

Merci

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

micsel

XLDnaute Junior

Bernard_XLD

XLDnaute Barbatruc

micsel

XLDnaute Junior

Pièces jointes

soan

XLDnaute Barbatruc

micsel

XLDnaute Junior

soan

XLDnaute Barbatruc

Pièces jointes

micsel

XLDnaute Junior

micsel

XLDnaute Junior

soan

XLDnaute Barbatruc

micsel

XLDnaute Junior

Discussions similaires