Copier/coller selon critère ou ajouter +1
Bonjour,
j'ai un peu honte, d'habitude j'ai toujours des pistes de code a peu près fonctionnel lorsque je fais une demande d'aide.
Je cherche à créer un bouton :
- qui copie des lignes d'un tableau4 (lignes sélectionnées selon critère),
- puis qui ajoute ces lignes au tableau15 (ou qui met +1 dans la colonne QUANTITE si lignes déjà présentes dans tableau15)
- puis qui supprime ces lignes du tableau4.
J'ai déjà la 3e partie du code, qui me permet de supprimer les lignes sélectionnées du tableau4.
Il me manque les 2 premières parties.
Private Sub CommandButton1_Click()
Dim ACell As Range, n As Long, i As Long
Application.ScreenUpdating = False
Set ACell = ActiveCell
If ACell.ListObject Is Nothing Then Exit Sub
If ACell.ListObject.Name = "Tableau5" And Len(ACell) > 0 Then
With ActiveSheet.ListObjects("Tableau4")
n = .ListRows.Count
For i = n To 1 Step -1
If .ListRows(i).Range.Cells(1, 8).Value = ACell.Value Then .ListRows(i).Delete
Next i
End With
End If
End Sub
En me relisant je m'aperçoit que ma demande est mal formulée, je vous joins le fichier ici.
Sans réponse,
j'essaye de trouver une solution...
Je suis sur une piste, mais je triche : je fais passer la sélection de ma première feuille (COMMANDE) dans le tableau d'une autre feuille (PARTIELLE) et je copie/colle les éléments de ce tableau sur ma feuille finale COMPTEUR.
C'est du bricolage !
Auriez-vous une alternative plus professionnelle qui pourrait copier/ajouter ma sélection directement de la première feuille (COMMANDE) à ma dernière feuille (COMPTEUR) ?
Aussi, je ne parviens toujours pas à ajouter un +1 dans le compteur si la sélection est déjà existante dans le tableau.
Qu'en pensez-vous ?
PS : je vous rappelle qu'il faut sélectionner un FOURNISSEUR avant de cliquer sur "ARCHIVER".
Private Sub Imp_partielle_Click()
Sheets("PARTIELLE").Range("C3").Value = ActiveCell.Value
Dim ws As Worksheet, e&, j&
Set ws = Worksheets("COMPTEUR")
e = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
With Worksheets("PARTIELLE")
j = .Range("A" & .Rows.Count).End(xlUp).Row
ws.Range("A" & e).Resize(j - 8, 5).Value = .Range("A9:K" & j).Value
End With
Dim ACell As Range, n As Long, i As Long
Application.ScreenUpdating = False
Set ACell = ActiveCell
If ACell.ListObject Is Nothing Then Exit Sub
If ACell.ListObject.Name = "Tableau5" And Len(ACell) > 0 Then
With ActiveSheet.ListObjects("Tableau4")
n = .ListRows.Count
For i = n To 1 Step -1
If .ListRows(i).Range.Cells(1, 8).Value = ACell.Value Then .ListRows(i).Delete
Next i
End With
End If
End Sub
Bonjour,
Je cherche à créer un bouton :
- qui copie des lignes d'un tableau4 (lignes sélectionnées selon critère),
- puis qui ajoute ces lignes au tableau15 (ou qui met +1 dans la colonne QUANTITE si lignes déjà présentes dans tableau15)
- puis qui supprime ces lignes du tableau4.
Quel est le critère de sélection ?
Il n'y a pas de Tableau15 dans le fichier !
Bonjour Steelson,
- le critère de selection est Activecell : une cellule que l'utilisateur doit sélectionner dans Tableau5 (un fournisseur).
- effectivement je ne suis pas parvenu à mon objectif : coller la sélection dans un Tableau15. Le tableau15 devait être situé sur la feuille "COMPTEUR". Dans le fichier associé à mon 2nd post, la sélection est collée sur la dernière ligne vide de la feuille, mais encore une fois c'est une solution bricolage qui ne me semble pas pérenne.
(en réalité le Tableau15 existe bien, dans la première pièce jointe associée à la création du post. Ayant travaillé sur une solution alternative ensuite, je l'ai supprimé et il n'apparait plus dans la pièce jointe suivante).
Ci-joint je te remets à disposition la pièce jointe originale, celle du 1er post :
Essaie ceci
Merci Steelson !
L'objectif de ce travail est de réaliser un compteur.
J'aimerai donc, dans la mesure du possible :
- que si les produits copiés existent déjà dans le Tableau15, la valeur "quantité" du produit soit ajoutée à la quantité déjà présente dans le Tableau15.
Par exemple, s'il ya dejà 3 BACTOPLUS (valeur QUANTITE de BACTOPLUS =3) dans le Tableau15, et qu'on Archive 4 BACTOPLUS supplémentaires, la valeur QUANTITE de la ligne BACTOPLUS du Tableau15 passe de 3 à 7.
As tu des éléments de réponse ?
Je vais me pencher sur la fonction tableau dynamique de Excel, je trouverai peut-être une alternative !
salut Samzou974
regarder ca :
Sub CBttn()
Dim ACell As Range, n As Long, i As Long
Dim tbl, c, ddrss
Set ACell = Selection
If ACell Is Nothing Or Not (ACell.Column = Nc And L < ACell.Row < U) Then
MsgBox "veuillez choisir une cellule dans le tbleau de produits"
End If
tbl = ACell
For i = n To p
Set c = Range("A4:A27").Find(tbl(n, 1), LookIn:=xlValues)
If Not c Is Nothing Then
Worksheets("COMPTEUR").Range("G" & n).Value = Worksheets("COMPTEUR").Range("G" & n).Value + Worksheets("COMMANDE").Range("J" & n + ou_mois_quelques_lignes).Value
End If
Next
End SubOù :
Nc : est la colonne de produit
L et U les cellules sélectionnées doivent être comprise entre L et U
For i = n To p : p la ligne de dernier produit
Sub archiver()
Dim ACell As Range, n As Long, i As Long
Application.ScreenUpdating = False
Set ACell = ActiveCell
If ACell.ListObject Is Nothing Then Exit Sub
If ACell.ListObject.Name = "Tableau5" And Len(ACell) > 0 Then
With ActiveSheet.ListObjects("Tableau4")
n = .ListRows.Count
For i = n To 1 Step -1
If .ListColumns("FOURNISSEUR").DataBodyRange.Rows(i).Value = ACell.Value Then
Range("Tableau4[[#Headers],[PRODUIT]:[PRIX]]").Offset(i, 0).Copy
Sheets("COMPTEUR").Select
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Sheets("COMPTEUR").Paste
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
.ListRows(i).Delete
End If
Next i
End With
End If
Sheets("TCD").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
End SubMerci à tous les deux.
Je découvre la puissance de la fonction tableau dynamique d'excel.
C'est beau !
Joyeuses fêtes et merci encore !!