Discussion :

[cobra38]

Bonjour à Tous ,

Je fais appel à votre aide car j'ai dans le fichier joint ( voir par ex CR21!R7 )
le besoin d'effectuer des recopies des fomules XL en VBA mais j'avoue mon ignorance en ce domaine
Le principe du fichier présenté est que l'utilisateur appuie sur un bouton pour inserer ou reocopier une ligne . Si pour l'insertion ou la recopie des lignes j'ai pu à peu près me débrouiller, je n'arrive pas à recopier les formules inscrites

Merci donc par avance pour votre aide

[LeForestier]

Bonjour,
Evidemment, si tu remplace la formule par "" elle ne saurait pas y être
supprimer la ligne..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

    'Cells(DerLig, "K") = ""

et allonger la copie pour avoir la dernière formule..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If Not Intersect(ActiveCell, Range("A5:P" & DerLig)) Is Nothing Then
    Range(Cells(lig, "A"), Cells(lig, "R")).Copy Destination:=Cells(DerLig, "A")

A+

[cobra38]

Merci LeForestier

J'ai honte

Bien sûr , il est evident que si je reduit à "" j'ai plus rien comme quoi quand on a le nez dedans ...
Merci quand même et mille excuses pour la perte de temps

J'ai une autre question si tu le permets , j'ai effectué une insertion de ligne ( module 1) par le bouton "ajout ligne comande ouverte " et j'aurais voulu incerementer dans ce cas la colonne B mais cela ne marche que si je selectionne la ligne plus basse et non pas la ligne à incerementer
ex
010 001
010 002 <= si je veux incrementer celle-ci
je dois selectionner la ligne 020 000
020 000

Merci encore ...
A+

[LeForestier]

Comme ça ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub AjoutLF()
Dim DerLig As Long, lig As Long, i As Long
 
DerLig = Range("A65500").End(xlUp).Row + 1
lig = ActiveCell.Row
'Ici tu faisais l'insertion AVANT de tester si la sélection est valable
If Not Intersect(ActiveCell, Range("A5:P" & lig)) Is Nothing Then
    For i = lig To DerLig ' si pas cliquer sur le dernier ajout
        If Cells(i, 1) <> ActiveCell Then Exit For
    Next i
 
    Rows(i).Insert Shift:=xlDown
    Range(Cells(lig, "A"), Cells(lig, "P")).Copy Destination:=Cells(i, "A")
 
    Cells(lig, "A") = Cells(i - 1, "A")
    Cells(lig, "B") = Cells(i - 1, "B") + 1
....
.....

A+

[cobra38]

Euhh pas tout à fait
Pourquoi tester les lignes actives si cette fonction est déjà utilisée "If Not Intersect ... " je ne comprends pas bien

En fait , le pb est que l'utilisateur ajoute une nouvelle ligne en identifiant n'importe quelle colonne de son choix
Je souhaiterai forcer l'utilisateur à choisr la ligne entière et non pas une colonne car si c'est le cas , un décalage malheureux se produit
Il faudrait que la ligne choisit soit la dernière incrémenter en B et non pas en A


Encore Merci
A+

[cobra38]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub AjoutLF()
Dim DerLig As Long, lig As Long
 
DerLig = Range("A65500").End(xlUp).Row + 1
lig = ActiveCell.Row
 
If Not Intersect(ActiveCell, Range("A5:Q" & DerLig)) Is Nothing Then
  Rows(lig).Insert Shift:=xlDown
  Range(Cells(lig, "A"), Cells(lig, "S")).Copy Destination:=Cells(lig, "A")
  lig = ActiveCell.Row
 
    Cells(lig, "A") = Cells(lig - 1, "A")
    Cells(lig, "B") = Cells(lig - 1, "B") + 1
    Cells(lig, "E") = "En Cours"
    Cells(lig, "H") = 0
    Cells(lig, "I") = 0
    Cells(lig, "J") = 0
 
 
   Else
    MsgBox "Sélectionner une ligne"
End If
 
 
 
End Sub

Voilà mon code pour l'insertion mais je me heurte à la perte des formules
Le principe est le suivant :
L'utilisateur selectionne une ligne "pleine" avec en colonne B = "000" puis
actionne le bouton "commande ouverte"
Cette action entraine bien l'incrementation de la ligne précédente mais je perds une fois de plus les formules (?)


A+