Microsoft 365 VBA - rajout d'1 ligne automatique avec la formule et les validations de données (liste déroulante)

blancolie

XLDnaute Impliqué
Bonsoir le forum,

je vous présente ce fichier et quelqu'un de ce forum m' a apporté la solution mais cela ne marche pas dans mon fichier peut a cause que je suis sous mac et version d'office 365, peut être la cause.

alors pour ceux qui sont sur mac et ceux aussi sur pc car office 365 fonctionne sur pc

Mon but est de rajouter une deuxième ligne quand la cellule A3 est remplie. il faut bien sur que dans la nouvelle ligne, les formules et les listes déroulantes apparaissent aussi.

je n'y connais rien du tout en vba.

Cordialement
 

Pièces jointes

  • fleurissement 2.xlsm
    46.9 KB · Affichages: 22
Dernière édition:
Solution
Avant de vous quitter voici dans ce fichier (3) une macro qui évite qu'on efface les formules :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim colf, ub%, tablo, i&, j%
colf = Array(2, 4, 5, 7) 'colonnes des formules, à adapter
ub = UBound(colf)
With [Tableau1]
    If Not Intersect(Target, .Cells) Is Nothing Then
        Set Target = Intersect(Target.EntireRow, .Cells)
        For Each Target In Target.Areas
            tablo = Target.Formula 'matrice, plus rapide
            For i = 1 To UBound(tablo)
                For j = 0 To ub
                    If Left(tablo(i, colf(j)), 1) <> "=" Then
                        MsgBox "Ne pas effacer les formules !", vbCritical
                        Application.EnableEvents = False...

blancolie

XLDnaute Impliqué
re bonsoir thierry;

peux tu m'orienter sur le code de job, j'essaye de comprendre :

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With [Tableau1]
    With .Rows(.Rows.Count + 1)
        If Not Intersect(ActiveCell, .Cells) Is Nothing And .Cells(0, 1) <> "" Then
            .Rows(0).Copy .Cells(1)
            .SpecialCells(xlCellTypeConstants).ClearContents
            .Cells(1).Select
        End If
    End With
End With
End Sub

ce code a été établit pour l'onglet zone de saisie. je souhaite l'adapter pour l'onget fanfelle. j'ai changer tableau1 par tableau4.

la ligne se crée mais j'ai une boite de dialogue qui apparait "erreur d'éxecution N°1004 - Pas de cellule correspondante. et quand je fais déboguer cela m'indique en surbrillance "SpecialCells(xlCellTypeConstants).ClearContents"

ou peut il avoir une erreur ?

si tu peux m'orienter.

merci.
 

job75

XLDnaute Barbatruc
Dans les macros que j'ai données une ligne s'ajoute si la dernière cellule en colonne A est remplie.

Pour que ça marche sur l'onglet Fantelle il faut que la dernière cellule en colonne B soit remplie :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With [Tableau4]
    With .Rows(.Rows.Count + 1)
        If Not Intersect(ActiveCell, .Cells) Is Nothing And .Cells(0, 2) <> "" Then
            .Rows(0).Copy .Cells(1)
            .SpecialCells(xlCellTypeConstants).ClearContents
            .Cells(1, 2).Select
        End If
    End With
End With
End Sub
 

job75

XLDnaute Barbatruc
Avant de vous quitter voici dans ce fichier (3) une macro qui évite qu'on efface les formules :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim colf, ub%, tablo, i&, j%
colf = Array(2, 4, 5, 7) 'colonnes des formules, à adapter
ub = UBound(colf)
With [Tableau1]
    If Not Intersect(Target, .Cells) Is Nothing Then
        Set Target = Intersect(Target.EntireRow, .Cells)
        For Each Target In Target.Areas
            tablo = Target.Formula 'matrice, plus rapide
            For i = 1 To UBound(tablo)
                For j = 0 To ub
                    If Left(tablo(i, colf(j)), 1) <> "=" Then
                        MsgBox "Ne pas effacer les formules !", vbCritical
                        Application.EnableEvents = False
                        Application.Undo 'annule les modifications
                        Application.EnableEvents = True
                        Exit Sub
                    End If
        Next j, i, Target
    End If
End With
End Sub
 

Pièces jointes

  • fleurissement(3).xlsm
    57.1 KB · Affichages: 5

blancolie

XLDnaute Impliqué
Bonjour Thierry

j'ai essaye de comprendre ta macro mais suis pas douée en vba. j'ai essaye de l'adapte ds ce fichier comme excercie mais cela ne marche pas. au lieu de tableau1 , cela s'appelle T_zoneSaisie

Ou ai je merder ?
 

Pièces jointes

  • Demande de Devis test.xlsm
    77.5 KB · Affichages: 5

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonsoir @blancolie , @job75 , le Fil, le Forum

J'ai l'impression Blancolie que tu ne comprends pas vraiment l'usage d'un Forum de partage de connaissance...

Ce n'est pas du tout comme ceci que tu apprendras quelque chose si tu pars dans tous les sens et que les contributeurs auront la patience d'essayer de te suivre/comprendre.

J'avis cru comprendre que le travail de Job correspondait à ta demande et que tu avais ta solution...
Maintenant tu fais machine arrière...

Pour cloturer ce fil, dans le fichier sur lequel j'avais écris ce code le 26/04, il correspondait à ceci :

1589046502310.png



Maintenant le fichier que tu fournis aujourdhui correspond à ceci ...
1589046468335.png


C'est clair que tu dois un peu réfléchir quand tu vois ce code :
VB:
        If CellZone.Offset(0, 3) = WsFournisseur.Name Then

Vu que tu as ajouté un préfix au nom de tes onglets tu dois penser à adapter comme ceci :
VB:
        If CellZone.Offset(0, 4) = Right(WsFournisseur.Name, Len(WsFournisseur.Name) - 6) Then
Pour pouvoir ignorer le préfix "Devis " qui fait 6 caractères...

Bon apprentissage
@+Thierry
 

blancolie

XLDnaute Impliqué
Bonjour Thierry,

je ne fais pas marche arrière, je cherche juste à travers ce post comprendre ce que tu as fait et le reproduire. c'est pour cela que je m'exerce. Commençons par un petit codage que par celui de JOB75 qui m'est utile mais trop compliqué à comprendre pour l'instant. Faire du copier/coller sans comprendre, pas intéressant pour moi.

Comme tu peux le constater, j'ai déja du mal à comprendre le tien et à le modifier.

En ce qui concerne ton travail :

effectivement j'ai rajouté devis car c'est plus parlant mais en ayant aucune notion, difficile de savoir qu'il fallait modifier les lignes la. j'avais juste pensé à changer T_zonesaisie qui est le nom du tableau à la place de Tableau11. Mes tableaux sont structurés.

Merci pour ton aide, je vais essayer de comprendre tes fonctions une par une. mais que veut dire -6 . Une soustraction ?

Cordialement
 

blancolie

XLDnaute Impliqué
bonjour ou bonsoir thierry,

bon j'ai compris a peu pres ton code mais pas entièrement. Voici ce que j'ai modifié :

VB:
Sub SaveZoneSaisieParFournisseur()
Dim Ws As Worksheet, WsFournisseur As Worksheet
Dim PlageZone As Range, CellZone As Range
Dim Ligne As Integer

Set Ws = ThisWorkbook.Worksheets("Zone de Saisie")
Set PlageZone = Ws.Range("A3:A" & Ws.Range("A5000").End(xlUp).Row)

For Each CellZone In PlageZone
    For Each WsFournisseur In ThisWorkbook.Worksheets
        If CellZone.Offset(0, 2) = WsFournisseur.Name Then
            Ligne = WsFournisseur.Range("B5000").End(xlUp).Row + 1
            With WsFournisseur
            .Cells(Ligne, 1) = CellZone.Offset(0, 1)
            .Cells(Ligne, 3) = CellZone.Offset(0, 4)
            .Cells(Ligne, 4) = CellZone.Offset(0, 3)
            .Cells(Ligne, 2) = CellZone.Offset(0, 0)
            End With
        End If
    Next WsFournisseur
Next CellZone
End Sub

Par contre , si j'ai par exemple plusieurs même fournisseurs, dans l'onglet fanfelle, je vois qu'une seule fois fanfelle mais pas 2 et ce n'est pas le premier fanfelle qui est recopié. Pareil pour les autres fournisseurs.

je ne vois pas du tout ou cela peut être. a part je comprends pas ligne =ws fournisseur.range("B5000").End(xIUP).Row +1. a part qu'il y a question de décalage il me semble.

merci
 

Pièces jointes

  • XLD_Blancolie_fleurissement 2_v00.xlsm
    56.2 KB · Affichages: 4

_Thierry

XLDnaute Barbatruc
Repose en paix
If CellZone.Offset(0, 2) = WsFournisseur.Name Then

Bonsoir @blancolie
Dans le code original, je ne regarde QUE si l'onglet se nomme comme le fournisseur pour aller le remplir. Je ne m'occupe pas des occurrences et des duplications de fournisseurs qu'il peut y avoir dans l'onglet "Zone de Saisie", si le fournisseur à le même (exactement le même) nom que son onglet "Fournisseur" il sera reporté à la dernière ligne de l'onglet correspondant.

Ce qui va répondre à cette question :
Ligne = WsFournisseur.Range("B5000").End(xlUp).Row + 1
Ca me sert justement pour trouver la dernière ligne

Bonne soirée
@+Thierry
 

blancolie

XLDnaute Impliqué
oui pour celle la , j'ai bien compris donc c'est pour créer une plage dynamique,

Par contre , je comprends pas pourquoi cela me recopie qu'une seule fois une plante chez fanfelle alors que j'ai plusieurs plantes de fanfelle et pareil pour les autres fournisseurs
 

Discussions similaires

Réponses
2
Affichages
592

Statistiques des forums

Discussions
312 184
Messages
2 086 007
Membres
103 088
dernier inscrit
Psodam