Inserer un ligne au lieu de saisie

Bonjour j'ai le code suivant et j'aime insérer un ligne a la en commence par (4) au lieu de mettre en bas de tableau de userform (offset)

Private Sub LigneTransfert()
  'remplir une ligne sur le tableau de la feuille "Transfert",
  'mais s'il n'y a plus de ligne libre, on ne fait rien !
  With Worksheets("Transfert")
    lgT = .Cells(Rows.Count, 1).End(3).Row + 1
    If lgT = 65000 Then
      MsgBox "Le tableau en feuille Transfert est plein !", 65000
      lgT = 0: Exit Sub 'on fait rien, et on sort de la sub !
    End If
    Dim Stock1&, Stock2&
    Application.ScreenUpdating = 0: .Unprotect
    Stock1 = Val(stocktr) - Val(Quantitetr): Stock2 = Val(stockdes) + Val(Quantitetr)
    With .Cells(lgT, 1)
      .Value = CB_Pièce          'Code article
      .Offset(, 1) = catetr      'Catégorie
      .Offset(, 2) = Desitr      'Désignation
      .Offset(, 3) = reftr       'Référence
      .Offset(, 4) = Date        'Date
      .Offset(, 5) = ComboBox1
      .Offset(, 6) = Val(stocktr)
      .Offset(, 7) = ComboBox2   'Provenance
      .Offset(, 8) = Val(stockdes)   'Destination
      .Offset(, 9) = Val(Quantitetr) 'Quantité transférée
      .Offset(, 10) = unitr     'Unité
    .Offset(, 11) = Stock1
    .Offset(, 12) = Stock2
    End With
    .Protect: Application.ScreenUpdating = -1
  End With
End Sub

Bonjour,

Désolé, je ne comprends pas la demande ...

ric

Alors le code au dessus me permet de copier des données a la fin du tableau sur la ligne vide

pour moi je veux au lieu de copier a la fin du tableau c'est possible d’insérer un nouveau ligne avec mes donnés bien sur et sur la ligne 4

Bonjour,

Un essai ...

Private Sub LigneTransfert()
  'remplir une ligne sur le tableau de la feuille "Transfert",
  'mais s'il n'y a plus de ligne libre, on ne fait rien !
  With Worksheets("Transfert")

   ' insère une ligne
      Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    lgT = 4

    dlig = .Cells(Rows.Count, 1).End(3).Row
    If dlig = 65000 Then
      MsgBox "Le tableau en feuille Transfert est plein !", 65000
      ''''lgT = 0: Exit Sub 'on fait rien, et on sort de la sub !
    End If

    Dim Stock1&, Stock2&
    Application.ScreenUpdating = 0: .Unprotect
    Stock1 = Val(stocktr) - Val(Quantitetr): Stock2 = Val(stockdes) + Val(Quantitetr)
    With .Cells(lgT, 1)
      .Value = CB_Pièce          'Code article
      .Offset(, 1) = catetr      'Catégorie
      .Offset(, 2) = Desitr      'Désignation
      .Offset(, 3) = reftr       'Référence
      .Offset(, 4) = Date        'Date
      .Offset(, 5) = ComboBox1
      .Offset(, 6) = Val(stocktr)
      .Offset(, 7) = ComboBox2   'Provenance
      .Offset(, 8) = Val(stockdes)   'Destination
      .Offset(, 9) = Val(Quantitetr) 'Quantité transférée
      .Offset(, 10) = unitr     'Unité
    .Offset(, 11) = Stock1
    .Offset(, 12) = Stock2
    End With
    .Protect: Application.ScreenUpdating = -1
  End With
End Sub

ric

Bonjour

Malheureusement ça fonctionne pas

Merci

Bonjour,

Si cela ne fonctionne pas > je suppose que tes données ne sont pas une plage de données > mais un tableau structuré ...

Ce qui est excellent ...

Dans le code ci-dessous > .Range("Tableau1") >> adapte le nom "Tableau1" au nom de ton tableau ...

Si tu ne connais pas le nom du tableau > clique n'importe où dans le tableau > dans le menu en haut à droite apparaît le mot "Création de tableau" ...

Clique sur "Création de tableau" > en haut à gauche > regarde "Nom du tableau" ...

Private Sub LigneTransfert_Click()
  'remplir une ligne sur le tableau de la feuille "Transfert",
  'mais s'il n'y a plus de ligne libre, on ne fait rien !
  With Worksheets("Transfert")

   ' insère une ligne
   .Range("Tableau1").Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    lgT = 4
'...
'...

NOTE : il serait bien de modifier ton profil du forum pour y inscrire la version de Excel que tu utilises > merci ...

ric

Oui ça marche merciiiiiiiiii

ric

Bonjour RIC

pour ce code la

Private Sub MajInventaire()
  Dim QS&, n&
  With Worksheets("Inventaire")
    n = UBound(TblInv): lgS = 0: lgD = 0
    GetLig ComboBox1, n, lgS: If lgS = 0 Then Exit Sub
    GetLig ComboBox2, n, lgD: flgAdd = 0
    If lgD = 0 Then
      flgAdd = -1: lgD = n + 3
      If lgD = 65000 Then
        MsgBox "Le tableau en feuille Inventaire est plein !", 48
        lgD = 0: Exit Sub 'on fait rien, et on sort de la sub !
      End If
    End If
    Application.ScreenUpdating = 0: .Unprotect: QT = Val(Quantitetr)
    With .Cells(lgS, 3)
      QS = .Value - QT: .Value = QS ': stocktr = QS
    End With
    With .Cells(lgD, 3)
      If flgAdd Then
        .Offset(, -2) = CB_Pièce           'Code article
        .Offset(, -1) = catetr             'Catégorie
        .Offset(, 2) = Val(seuil)              'Seuil d'alerte
        .Offset(, 3) = Desitr              'Descriptif
        .Offset(, 4) = reftr               'Référence
        .Offset(, 5) = unitr               'Unité de mesure
        .Offset(, 6) = "Transfert"         'Observations
        .Offset(, 9) = ComboBox2           'Magasin
      End If
      QD = Val(.Value) + QT: .Value = QD   'Stock actuel
    End With
    .Protect: Application.ScreenUpdating = -1
  End With
End Sub

même chose "insérer sur la feuille inventaire au lieu de saisie"

Bonjour,

Ce code ci est plus difficile à comprendre sans fichier ...

Un essai ...

'Private Sub MajInventaire()
Private Sub MajInventaire_Click()

  Dim QS&, n&
  With Worksheets("Inventaire")

     ' insère une ligne
   .Range("Tableau1").Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    lgD = 4
'...
'...

ric

J'ai essayer de joindre le fichier ms c'est un peut lourd 1.82Mo

Bonjour,

Ne conserve que quelques lignes du tableau concerné > attention aux données personnelles à anonymiser ...

ric

Alors ci joint le fichier et merci d'avance

Bonjour,

Ce n'est pas un tableau structuré > l'on revient donc à insérer une ligne de cette façon : Rows("4:4").Insert ...

Par contre > ce n'est que plus loin dans le code que tu déprotèges la feuille > j'ai donc ajouté un ".unprotect" > qu'il y ait 2 .unprotect à la suite > ça n'a pas de conséquence ...

Enfin > l'on copie le format de la ligne de dessous sur la nouvelle ligne > sinon > elle aurait le format de la ligne 3 (les entêtes) ...

Private Sub MajInventaire()
Dim QS&, n&
   With Worksheets("Inventaire")
      .Unprotect
      ' insère une ligne
      Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Rows("5:5").Copy
      Rows("4:4").PasteSpecial xlPasteFormats
      lgD = 4

'...
'...
'...

ric

Bonjour

Malheureusement ça fonctionne pas

Merci

Bonjour,

Pourtant cela fonctionne correctement sur le fichier exemple que tu nous as fourni ...

La ligne s'insère bien en ligne 4 > le format de la ligne 5 est copié sur la ligne 4 >

Ton fichier étant passablement anonymisé > seule la quantité s'inscrit ...

Mais je ne doute pas que cela fonctionne sur le fichier de travail ...

ric

Ton fichier de test en retour ...

Voila le débogage

Bonjour,

Ce bloquage sur la ligne en jaune se produit sur ton fichier de travail ...

Se produit-il aussi sur le fichier exemple que je t'ai retourné ?

Aussi > quelle version de Excel tu utilises ??

ric

excel 2013

Bonjour,

Oh là ! je suis gêné ...

J'ai oublié les points devrant les mots Rows ...

En utilisant un With worksheets ... > il faut mettre une point devant les objects s'y rapportant tels : .Rows > .Cells > .Range > etc.

Private Sub MajInventaire()
Dim QS&, n&
   With Worksheets("Inventaire")
      .Unprotect
      ' insère une ligne
      .Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      .Rows("5:5").Copy
      .Rows("4:4").PasteSpecial xlPasteFormats
      lgD = 4

'...
'...
'...

ric