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

  • Initiateur de la discussion Initiateur de la discussion micsel
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

micsel

XLDnaute Junior
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.
 
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
 
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

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
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
10
Affichages
547
Réponses
17
Affichages
1 K
Retour