Création automatique d'une ligne

sadicla

XLDnaute Occasionnel
Bonjour à tous

Je suis toujours sur ma feuille de métrés et je voudrais si c'est possible, avoir une nouvelle ligne , au fur et à mesure de mes saisies lorsque je passe à la ligne suivante . J'avais au départ fait un tableau de 3000 lignes ( j'ai vu un peu grand je l'avoue ) mais lorsque je fais des filtres quelconque, ou d'autres manipulations simples, il y a d'énormes lenteurs dues sans doute au fait que dans ces 3000 lignes il y a 8 formules en tout, donc 24000 formules c'est trop . C'est pour cette raison que je voudrais pouvoir avoir un tableau qui se construise au fur et à mesure . Oups j'espère que je suis clair ... ( pas sur çà !!! ) . Je mets un exemple de mon fichier . Merci à tous d'avance, et bonne journée .
 

Pièces jointes

  • Feuille de métrés.zip
    164.1 KB · Affichages: 49
  • Feuille de métrés.zip
    164.1 KB · Affichages: 50
  • Feuille de métrés.zip
    164.1 KB · Affichages: 50
Dernière édition:

sadicla

XLDnaute Occasionnel
Re : Création automatique d'une ligne

Ah "yes" !!! Vu !!! Trop fort tout çà , vraiment trop fort !!! Encore bravo Job75 .
Effectivement si je veux pas me retrouver avec un fichier sans titre, la version "4" était indispensable . D'autant que comme précisé, ma collègue qui va utiliser aussi ce fichier ne connait strictement rien en Excel ... Encore, moi je vois à peu près le fonctionnement, mais elle pas du tout .
Ce site est vraiment super . Il y a 4/5 ans en arrière j'avais lancé une demande pour essayer de faire un programme qui puisse m'aider à établir des devis, et j'ai été stupéfait par toute l'aide que j'ai eu , entre autre un certain Bruno ... qui se reconnaitra peut-être . A la suite de çà , j'utilise ce programme que vous tous m'avez aidé à faire depuis 5 ans .
Encore bravo et merci .
 

job75

XLDnaute Barbatruc
Re : Création automatique d'une ligne

Bonjour sadicla, le forum,

Pour terminer correctement ce fil.

Sauf si l'utilisateur est vicieux, il est plus logique de mettre la ligne modèle en ligne 1 masquée :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Variant, piece As Variant
lig = Application.Match("S.TOTAUX", [A:A], 0)
If IsError(lig) Then MsgBox "Il faut ""S.TOTAUX"" en colonne A !", 48: Exit Sub
If IsEmpty(Cells(lig - 1, 1)) Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive l'action des événements
Me.AutoFilterMode = False 'désactive le filtre automatique
Rows(lig).Insert
Rows(1).Copy Rows(lig) 'pour les formats
Rows(lig).ClearContents
If lig > 3 Then
  piece = Cells(lig - 1, 1) 'mémorise
  Rows(1).Copy Rows(lig - 1) 'pour les formules
  Cells(lig - 1, 1) = piece
End If
Rows(lig - 1).Resize(2).Hidden = False 'affiche les lignes masquées
[A2:H2].Resize(lig - 2).AutoFilter 'replace le filtre automatique
Application.EnableEvents = True
End Sub
Notez que dans les formules des "S.TOTAUX" le -2 a été remplacé par -3.

Fichier (5).

A+
 

Pièces jointes

  • Feuille de métrés relookée(5).xls
    75 KB · Affichages: 40

sadicla

XLDnaute Occasionnel
Re : Création automatique d'une ligne

B'jour le monde
@Job75
Que dire ... C'est super . Effectivement la ligne modèle en ligne 1 masquée est beaucoup plus simple et largement suffisante au niveau sécurité . Voilà une chose qui ne me demandait pas trop de compétence, j'aurais pu le faire , mais hélas la réflexion n'est pas encore là ... Ce qu'il y a de bien, c'est pour y accéder en cas de modifs de format par exemple, c'est beaucoup plus facile que de modifier puis lancer une macro . Merci pour cette finalisation .
Bonne journée

Edit1 : Encore une dernière demande . Je cherche à colorier la cellule active dans mon tableau, j'ai vu sur le site beaucoup d'exemples et de méthodes pour y arriver (macro, MFC ... ) mais je n'arrive pas à intégrer çà dans mes macros actuelles . Encore une "titite" aide peut-être ??

Edit2 : bon chercher plus, j'y suis arrivé . J'ai mis ceci dans ma feuille ( trouvé sur votre site , merci à l'auteur )
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlNone
ActiveCell.Interior.ColorIndex = 28
End Sub

J'ai juste été obligé de mettre des formats conditionnels dans mes titres de colonnes, car les couleurs s'effaçaient.
Je mets pour ceux que çà intéresseraient le fichier final . Merci encore à toi Job75 !! sans oublier PierreJean
 

Pièces jointes

  • Feuille de métrés.xls
    61.5 KB · Affichages: 57
Dernière édition:

job75

XLDnaute Barbatruc
Re : Création automatique d'une ligne

Bonjour Ryadtlemcen, bienvenue sur XLD, bonjour le forum,

Excusez le retard mais j'étais en voyage.

Ce n'est pas le même problème, votre fichier est différent.

Voici une solution (clic droit sur l'onglet et Visualiser le code) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Dim derlig As Long, cel As Range
derlig = Cells(Rows.Count, "C").End(xlUp).Row
If derlig < 2 Then Exit Sub 'sécurité
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("A" & derlig + 2 & ":F" & Rows.Count).Delete xlUp
For Each cel In [A3:F3].Resize(derlig - 1)
  If IsEmpty(cel) Then Cells(1, cel.Column).Copy cel
Next
Application.EnableEvents = True
End Sub
Le tableau s'ajuste automatiquement avec les formats et les formules copiés sur la ligne 1 (masquée).

Votre fichier joint.

A+
 

Pièces jointes

  • Test Ryad(1).xls
    38.5 KB · Affichages: 31
  • Test Ryad(1).xls
    38.5 KB · Affichages: 37
  • Test Ryad(1).xls
    38.5 KB · Affichages: 36

job75

XLDnaute Barbatruc
Re : Création automatique d'une ligne

Re,

Autre solution, plus rapide :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
Dim derlig As Long, cel As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next 'sécurité
Intersect([A:F], Range("C3:C" & Rows.Count) _
  .SpecialCells(xlCellTypeBlanks).EntireRow).Delete xlUp
derlig = Cells(Rows.Count, "C").End(xlUp).Row
For Each cel In Range("A" & derlig & ":F" & derlig + 1)
  If IsEmpty(cel) Then Cells(1, cel.Column).Copy cel
Next
Application.EnableEvents = True
End Sub
Bien noter :

- si l'on efface une valeur en colonne C, la ligne est supprimée

- seules les cellules de la dernière ligne et de la ligne suivante sont ensuite traitées.

Fichier (2).

A+
 

Pièces jointes

  • Test Ryad(2).xls
    39.5 KB · Affichages: 32
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote