Ne copier/coller que certaines colonnes selon une condition

Salut,

Tiens le code de linecopy() me dit quelque chose. Mais on en a enlevé, et on en a ajouté.
Dis-moi à quoi servent les lignes 5 et 7 ! A rien ? Vire-les.
Et ce paramètre clear de la fonction linecopy() ? Vestige d'un autre topic... Vire-le aussi.
Quel intérêt de la ligne 25 ? Tu ne t'en resers jamais. Vire-la.

Tu ne copies plus des lignes, alors ne te sers plus de linecopy().

Ca me paraît bizarre ce For j. Si pour une ligne la colonne G et la colonne H contiennent des valeurs non nulles, la ligne est copiée deux fois.
J'aurais tendance à dire "Si pour une ligne la colonne G ou la colonne H contiennent une valeur non nulle, copier la ligne".
A toi de voir.

Ca donne pour l'instant :

Option Explicit

Sub Devis()
 
Dim ws_source As Worksheet
Dim cel_cible As Range
Dim i As Long
 
Set ws_source = Worksheets("Prix matière" )
Set cel_cible = Worksheets("Devis" ).Rows(1) 'Feuille vierge 1ère ligne
 
For i = 3 To 23
    If ws_source.Cells(i, 7).Value <> 0 Or _
    	 ws_source.Cells(i, 8).Value <> 0 Then
        ws_source.Rows(i).Copy Destination:=cel_cible
        Set cel_cible = cel_cible.Offset(1)
    End If
Next
 
End Sub

Pour clarifier encore plus les choses, je vais directement traiter la zone G3:H23 :

Sub Devis()
 
Dim cel_source As Range
Dim cel_cible  As Range
 
Set cel_cible = Worksheets("Devis" ).Rows(1) 'Feuille vierge 1ère ligne
 
For Each cel_source In Worksheets("Prix matière" ).Range("G3:G23")
    If cel_source.Value <> 0 Or cel_source.Offset(0, 1).Value <> 0 Then
        cel_source.EntireRow.Copy Destination:=cel_cible
        Set cel_cible = cel_cible.Offset(1)
    End If
Next
 
End Sub

Etudie bien la fonction Offset().

Bon, maintenant, ce n'est pas toute la ligne (EntireRow) qu'on veut copier. Ben il va falloir le faire cellule par cellule.

For Each cel_source In Worksheets("Prix matière" ).Range("G3:G23")
    If cel_source.Value <> 0 Or cel_source.Offset(0, 1).Value <> 0 Then
        cel_cible.Offset(, x1).Value = cel_source.Offset(, y1).Value
        cel_cible.Offset(, x2).Value = cel_source.Offset(, y2).Value
        cel_cible.Offset(, x3).Value = cel_source.Offset(, y3).Value
        cel_cible.Offset(, x4).Value = cel_source.Offset(, y4).Value
        cel_cible.Offset(, x5).Value = cel_source.Offset(, y5).Value
 
        Set cel_cible = cel_cible.Offset(1)
    End If
Next

Il reste maintenant à trouver MATERIEL dans Devis et donc à remplacer la ligne

Set cel_cible = Worksheets("Devis" ).Rows(1)

Merci pour tes précieux conseils !

Alors j'ai commencé à adapter le code que tu m'as proposé après avoir bien pris connaissance de la fonction Offset.

Donc pour le report des colonnes cela fonctionne par contre le souci, c'est que je souhaiterai que les lignes soient insérées en dessous la ligne cible alors que pour le moment il copie par dessus les lignes existantes...

Pour l'instant, je n'ai pas encore trouvé le moyen de lui faire identifier la cellule contenant le mot "MATERIEL" comme celulle cible. Dois-je utiliser une fonction .Find ou bien une formule du type value = "MATERIEL" ? J'ai essayé cette dernière solution mais ça n'a pas fonctionné.

Merci encore.

M'enfin, qu'est-ce que tu racontes ?
Il n'y a pas d'insertion de lignes ! Il y a copie de lignes dans une feuille vierge.
La cible est initialisée comme cela :

Set cel_cible = Worksheets("Devis" ).Rows(1) 'Feuille vierge 1ère ligne

Si ta feuille n'est pas vierge, il faut identifier la dernière ligne non-vide de ta feuille, et prendre la suivante. Je te laisse chercher un peu.

-----------------------------

Comment ça, tu as essayé mais ça n'a pas fonctionné. Donne le code essayé.
Find() devrait donner de bon résultat.

Sinon, tu peux aussi te servir d'Excel : nomme une cellule et utilise ce nom :

worksheets(x).Range("nom_de_la_cellule")

Il y a eu un souci de compréhension, je me suis mal expliqué.

Dans mon premier message, j'avais bien précisé que pour l'instant je faisais le test sur un document vierge à partir de la 1ère ligne mais que dans un futur plus ou moins proche, je souhaitais faire la copie à partir d'une cellule donnée (celle qui contient le mot MATERIEL).

C'est pourquoi j'avais précisé que je souhaitais intégrer (j'aurais dû dire "insérer") le nombre de lignes correspondantes (à la condition).

Car en dessous des lignes insérées, j'ai de nouveau des cellules "fixes".

Pour repréciser mon besoin :
Je travaille à partir d'une feuille excel qui liste différents matériels pour effectuer des devis.
Lorsque je sélectionne des matériels à partir des colonnes G ou H, je souhaite que ces matériels sélectionnés soient copiés dans la feuille devis à partir de la ligne matériel.

Sur la feuille "Devis", j'ai donc : la ligne Matériel (qui sert de référence), en dessous une ligne vierge dans laquelle certaines cellules comprennement des formules et en dessous une ligne pour calculer des totaux.

En dessous ces lignes, j'ai encore d'autres éléments mais complétés manuellement.

Je souhaite donc que ma les lignes se copient à partir de la ligne vierge en dessous matériel et également que lorsqu'une ligne est insérée que les formules soient conservées.

J'espère avoir été clair au niveau de mes explications.

Je poste mon code avec .find par la suite.

Merci

Donc voici le code actuellement et qui fonctionne.

Sub Devis()

 
Dim cel_source As Range

Dim cel_cible  As Range

 
Set cel_cible = Worksheets("Devis").Range("B:B").Find("MATERIEL", searchdirection:=xlPrevious)

 
For Each cel_source In Worksheets("Prix matière").Range("I3:I52")

    If cel_source.Value <> 0 Or cel_source.Offset(0, 1).Value <> 0 Then

          cel_cible.Offset(1, 0).Value = cel_source.Offset(, -6).Value   

          cel_cible.Offset(1, 1).Value = cel_source.Offset(, -2).Value   

          cel_cible.Offset(1, 2).Value = cel_source.Offset(, -1).Value   

          cel_cible.Offset(1, 3).Value = cel_source.Offset(, 0).Value    

          cel_cible.Offset(1, 4).Value = cel_source.Offset(, 1).Value    

          cel_cible.Offset(1, 5).Value = cel_source.Offset(, 4).Value    

          cel_cible.Offset(1, 9).Value = cel_source.Offset(, 6).Value    

 
    Set cel_cible = cel_cible.Offset(1)

 
    End If

 
Next

 
End Sub

Les cellules se copient aux endroits désirés, le seul souci comme je l'ai précisé dans mon message précédent, c'est que ce tableau n'est pas vierge. Il faut donc que je parvienne à insérer les lignes et non les copier directement.

Ahhhhhhhh  

Juste un petit truc : juste après la ligne 6, vérifie que quelque chose a bien été trouvé. On ne sait jamais :

If cel_cible Is Nothing Then

    MsgBox "Impossible de trouvé MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

End If

Encore un petit truc, encore plus petit. La ligne 18 est mal indentée.

Tiens, c'est marrant, j'aurais mis la ligne 18 avant la ligne 10, pour ne pas avoir à faire trop de décalages.

-------------------------

Bon, maintenant, comment insérer une ligne. Alors je serais tenté de te proposer de demander à l'enregistreur de macro. Qui alors te dirait

Rows("8:8").Select

Selection.Insert Shift:=xlDown

Beurk. A traduire en :

Rows(8).Insert Shift:=xlDown

La ligne 8, c'est un exemple. A la place, on voudrait bien la ligne après MATERIEL. Ca donne :

Dim cel_source As Range

Dim cel_cible  As Range

 
Set cel_cible = Worksheets("Devis" ).Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

If cel_cible Is Nothing Then

    MsgBox "Impossible de trouvé MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

End If

 
For Each cel_source In Worksheets("Prix matière" ).Range("I3:I52" )

    If cel_source.Value <> 0 Or _

       cel_source.Offset(, 1).Value <> 0 _

    Then

        Set cel_cible = cel_cible.Offset(1)

        cel_cible.EntireRow.Insert Shift:=xlDown

 
        cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value 

        cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value 

        cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value 

        cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value   

        cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value   

        cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value   

        cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value   

 
    End If

Next

Encore merci pour les conseils. Voici le code :

Sub Devis()

 
Dim cel_source As Range

Dim cel_cible  As Range

 
Set cel_cible = Worksheets("Devis").Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

 
If cel_cible Is Nothing Then

    MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

End If

 
For Each cel_source In Worksheets("Prix matière").Range("I3:I122")

If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

Set cel_cible = cel_cible.Offset(1)

    cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

    cel_cible.Range("H:J", "L:N").Select

    Selection.AutoFill Destination:=cel_cible.Offset(1)       'je ne parviens pas à désigner la ligne qui a été ajoutée

 
        cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value 

        cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value  

        cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value  

        cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value    

        cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value    

        cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value    

        cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value    

 
End If

 
Next

 
End Sub

Jai modifié la ligne 16, car je souhaitais que les lignes soient insérées en dessous la ligne vierge plutôt qu'en dessous de la ligne MATERIEL.

Par contre, j'ai un souci pour incrémenter la ligne insérée. Comme je l'ai noté dans le code, je n'arrive pas à désigner cette ligne insérée. Faut-il déclarer une variable ?

Le message d'erreur est le suivant pour la ligne 18 : "Erreur d'exécution '1004': La méthode AutoFill de la classe Range a échoué."

Merci d'avance.

Arggghhhhh x_X      
Je ne veux pas voir de Truc.Select/Selection.Machin() dans le code des gens que j'aide !!!!! Merci de les remplacer par des Truc.Machin(). Picétou (c)PL

'je ne parviens pas à désigner la ligne qui a été ajoutée

Euh, il faudrait que je teste mes codes avant que je te les propose  

MsgBox cel_cible.Address
cel_cible.EntireRow.Insert
MsgBox cel_cible.Address

La cellule cible ne bouge pas. Donc la nouvelle ligne est un cran en dessous, soit cel_cible.Offset(1). Evidemment, dans ton code, on se décale encore d'une ligne. Donc :

cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown
Set newline = cel_cible.Offset(2).EntireRow

Range("H:J", "L:N" )

Non, non et non. Il faudrait écrire

Range("H:J,L:N" )

Mais ça ne peut pas marcher.

Pour créer ta zone, plusieurs solutions :

' // Soluce 1 - Beurk
Set MaZone = Range("H" & cel_cible.Row & ":J" & cel_cible.Row & ",L" & cel_cible.Row & ":N" & cel_cible.Row )
 
' // Soluce 2 - Pour 2 ou 3, ça va encore... Pour 6, à la rigueur...
Set MaZone = Union(cel_cible.Offset(,6), cel_cible.Offset(,7), cel_cible.Offset(,8), cel_cible.Offset(,10), cel_cible.Offset(,11), cel_cible.Offset(,12))
 
' // Soluce 3 - Ma préférée
Set Les6Colonnes = Worksheets("ma_feuille" ).Range("H:J,L:N")
Set MaZone = Intersect(cel_cible.EntireRow, Les6Colonnes)
 
' // On peut aussi écrire directement comme ça : 
Set MaZone = Intersect(cel_cible.EntireRow, cel_cible.Worksheet.Range("H:J,L:N"))

Pour ta mise au point, n'hésite pas à ajouter des MsgBox ma_cellule.Address partout pour savoir où tu en es  
Si les $ te perturbent, utilise ma_cellule.Address(False, False).


A te lire.....
Je sens qu'on est proche du dénouement.

Je sens également qu'on est plus proche de la fin que du début malheureusement, il reste encore un bout de chemin à parcourir.

Voici le nouveau code :

Option Explicit

 
Sub Devis()

 
Dim cel_source As Range

Dim cel_cible  As Range

Dim newline As Range

Dim Les6Colonnes As Range

Dim MaZone As Range

 
Set cel_cible = Worksheets("Devis").Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

    If cel_cible Is Nothing Then

    MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

End If

 
For Each cel_source In Worksheets("Prix matière").Range("I3:I122")

    If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

        Set cel_cible = cel_cible.Offset(1)

        cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

        Set newline = cel_cible.Offset(2).EntireRow

        Set Les6Colonnes = Worksheets("Devis").Range("H:J,L:N")

        Set MaZone = Intersect(cel_cible.EntireRow, Les6Colonnes)

 
        MaZone.AutoFill Destination:=newline

 
        cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value 

        cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value  

        cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value  

        cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value   

        cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value  

        cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value    

        cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value   

End If

 
Next

 
End Sub

J'ai de nouveau le même message d'erreur au niveau de la ligne 21 : "Erreur d'exécution '1004': La méthode AutoFill de la classe Range a échoué."

Si j'enlève cette ligne 21, les lignes sont insérées et correctement copiées par contre les formules ne sont pas incrémentées et certains éléments de la mise en forme ne sont pas reproduits (ex : bordure) par contre c'est bon pour la couleur de fond.

Je poursuis mes essais.

EDIT : j'ai bien lu le paragraphe sur l'indentation, j'espère que la présentation du code sera plus "agréable"...

Je ne t'aide plus si tu ne m'indentes pas correctement ton code.  

Ajoute aussi Option Explicit au début de ton code, et déclare tes variables.

EDIT: Eh, c'est la méthode AutoFill() qui n'est pas appropriée. Utilise Copy(Destination) ou explique plus exactement ce que tu veux faire.

Alors pour préciser mon besoin :
Sur ma feuille "Devis", j'ai donc la ligne avec MATERIEL en colonne B qui me sert de "référence".
En dessous cette ligne, j'ai une ligne dans laquelle je copie certaines cellules issues de la feuille "Prix matière" grâce à la macro. Sur cette même ligne, j'ai des formules qui se calculent automatiquement une fois les données copiées.
Pour cette 1ère ligne, cela fonctionne.

Par contre, les autres lignes qui sont insérées grâce à la macro ne présentent pas exacement le même format et les formules ne sont pas conservées.

Dernier point, je souhaite conserver une autre ligne en bas de ce bloc qui calcule le total des lignes insérées. Pour cette partie, je crois que l'incrémentation se fait automatiquement étant donné que la ligne est déjà présente avant l'exécution de la macro.

Merci encore.

EDIT : alors après quelques tests, je n'arrive toujours pas à intégrer les formules sur les lignes insérées.
Par contre, je vais modifier légèrement mon besoin.
Pour faciliter la chose : on va dire que MATERIEL se situe en A1.
A partir de la ligne 2 : je commence à insérer les lignes copiées.
En C3 : j'ai actuellement une formule qui se présente de la sorte =SOMME(C2:C2)*B3 ou =SOMME(C2)*B3 (j'ai essayé des deux manières) --> lorsque j'insère une ligne au-dessus (même manuellement), la formule reste telle quelle.
En C4 : j'ai la formule =SOMME(C2:C3) et lorsque j'insère une ligne au-dessus de C3 comme le fait la macro la formule s'incrémente.
J'ai donc un souci au niveau de l'incrémentation de la formule en C3.

Oki. C'est clair pour moi maintenant.
Pour l'intentation, c'est presque ça (lignes 12 & 34 )  

Dim lig_materiel As Range
Dim col_intersec As Range
Dim lig_cible    As Range
Dim ws_devis     As Worksheet
 
Set ws_devis = Worksheets("Devis" )
 
' // J'ai viré le SearchDirection, inutile et faux
Set lig_materiel = ws_devis.Columns(2).Find("MATERIEL").EntireRow
If lig_materiel Is Nothing Then
    MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly
    Exit Sub
End If
 
' // Il faut déterminer combien de lignes sont déjà présentes
' // pied du tableau = "je souhaite conserver une autre ligne en bas de ce bloc qui calcule le total des lignes insérées."
 
' // S'il y a au moins un espace vide entre la dernière ligne du tableau et le pied du tableau 
Set lig_cible = ws_devis.Columns(2).End(xlDown).EntireRow
 
' // Si le pied du tableau contient un mot clef comme la tête du tableau contenait MATERIEL
Set lig_cible = ws_devis.Columns(2).Find("PIED").EntireRow ' // <- /!\ je n'ai pas fait de gestion d'erreur
 
' // Si le pied du tableau contient une cellule nommée
Set lig_cible = ws_devis.Range("PIED").Offset(-1).EntireRow
 
' // Sinon, par exemple on ajoute après la ligne de référence.
Set lig_cible = lig_materiel.Offset(2)
 
' // J'ai sorti cette ligne de la boucle. Inutile de faire 120 fois la même chose
Set col_intersec = Worksheets("Devis" ).Range("H:J,L:N" )
 
For Each cel_source In Worksheets("Prix matière" ).Range("I3:I122" )
    If cel_source.Value <> 0 Or _
       cel_source.Offset(, 1).Value <> 0 _
    Then
        ' // On insert une ligne juste après la ligne lig_cible en cours
        ' // J'ai viré le Shift inutile.
        lig_cible.Insert
        Set lig_cible = lig_cible.Offset(-1)
 
        ' // Maintenant, on copie la ligne de référence dans la nouvelle ligne
        ' // Les attributs sont conservés, les formules aussi.
        lig_materiel.Offset(1).Copy lig_cible
 
        ' // S'il y a des valeurs dont on ne veut pas, on les supprime a posteriori
 
        ' // Ou on les écrase :
        lig_cible.Cells(2).Value = cel_source.Offset(, -6).Value
        lig_cible.Cells(3).Value = cel_source.Offset(, -2).Value 
        lig_cible.Cells(4).Value = cel_source.Offset(, -1).Value 
        lig_cible.Cells(5).Value = cel_source.Offset(, 0).Value 
        lig_cible.Cells(6).Value = cel_source.Offset(, 1).Value 
        lig_cible.Cells(7).Value = cel_source.Offset(, 4).Value   
        lig_cible.Cells(11).Value = cel_source.Offset(, 6).Value 
    End If
Next

Tout d'abord bonjour,

J'ai bien essayé le code hier, mais le résultat n'est pas celui attendu...

J'ai essayé en le modifiant mais sans plus de succès... Actuellement, il insère des lignes vierges en trop, avec des formats différents d'une ligne à l'autre et en efface également.

Voici le code que j'ai placé dans la macro :

Sub Devis()

 
Dim ws_devis     As Worksheet

Dim lig_materiel As Range

Dim col_intersec As Range

Dim lig_cible    As Range

Dim cel_source   As Range

 
Set ws_devis = Worksheets("Devis")

 
Set lig_materiel = ws_devis.Columns(2).Find("MATERIEL").EntireRow

If lig_materiel Is Nothing Then

    MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

End If

 
Set lig_cible = lig_materiel.Offset(1)  ' // Sinon, par exemple on ajoute après la ligne de référence.

Set col_intersec = ws_devis.Range("H:J,L:N")

 
For Each cel_source In Worksheets("Prix matière").Range("I3:I122")

    If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

        lig_cible.Insert

        Set lig_cible = lig_cible.Offset(1)

        lig_materiel.Offset(1).Copy lig_cible   ' // Maintenant, on copie la ligne de référence dans la nouvelle ligne

 
        lig_cible.Cells(2).Value = cel_source.Offset(, -6).Value

        lig_cible.Cells(3).Value = cel_source.Offset(, -2).Value

        lig_cible.Cells(4).Value = cel_source.Offset(, -1).Value

        lig_cible.Cells(5).Value = cel_source.Offset(, 0).Value

        lig_cible.Cells(6).Value = cel_source.Offset(, 1).Value

        lig_cible.Cells(7).Value = cel_source.Offset(, 4).Value

        lig_cible.Cells(11).Value = cel_source.Offset(, 6).Value

    End If

Next

 
End Sub

Je reprécise mon besoin et le format de ma feuille "Devis" pour le bloc MATERIEL :
Pour faciliter la chose, on va dire que MATERIEL se situe en A1.
A partir de la ligne 2 : je commence à insérer les lignes copiées.
En C3 : j'ai actuellement une formule qui se présente de la sorte =SOMME(C2:C2)*B3 ou =SOMME(C2)*B3 (j'ai essayé des deux manières) --> lorsque j'insère une ligne au-dessus (même manuellement), la formule reste telle quelle.
En C4 : j'ai la formule =SOMME(C2:C3) et lorsque j'insère une ligne au-dessus de C3 comme le fait la macro la formule s'incrémente.
J'ai donc un souci au niveau de l'incrémentation de la formule en C3.

Je vais poursuivre les tests.

Salut,

M'enfin, que devient ta ligne de référence qui est censée se trouver sous MATERIEL ?
Tu changes la configuration à chaque fois  

Rhooolala, je viens de vérifier le code que je t'ai donné (Je n'ai pas toujours Excel sous la main, désolé).... J'ai corrigé le code. A la ligne 23 de ton code, il faut remonter d'une ligne, donc se décaler de -1 ligne.

Bon, sinon effectivement, Excel est assez espiègle quand il s'agit d'auto-incrémentation. Une solution consiste a réécrire la formule.

' // On cherche MATERIEL dans la colonne 2

Set lig_matos = ws_devis.Columns(2).Find("MATERIEL").EntireRow

' // On trouve MATERIEL ...

If lig_matos Is Nothing Then

    ' // ... Ou pas

    MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

End If

 
' // On dit que le pied de tableau est juste après...

Set lig_somme = lig_matos.Offset(1)

Do While True

    ' // On vérifie que ce pied de page contient une formule de type =Somme(..)..

    If lig_somme.Cells(3).Formula Like "=SUM(*" Then Exit Do

    ' // Sinon, c'est peut être la suivante

    Set lig_somme = lig_somme.Offset(1)

    ' // Mouhais. Qui a oublié de faire un pied de tableau plein de sommes ?

    If lig_somme.Row > 60000 Then

        MsgBox "Impossible de trouver le pied de tableau.", vbCritical Or vbOKOnly

        Exit Sub

    End If

Loop

 
' // On recopie les valeurs qui nous intéressent

For Each cel_source In Worksheets(2).Range("I3:I122")

    lig_somme.Insert

    Set lig_cible = lig_somme.Offset(-1)

 
    lig_cible.Cells(...).Value = cel_source.Offset(...).Value

Next

 
' // Et on recalcule la somme en colonne C

lig_somme.Cells(3).Formula = "=SUM(" & ws_devis.Range(lig_matos.Offset(1), _

                                                      lig_somme.Offset(-1)).Columns(3).Address & _

                                 ")*" & lig_somme.Cells(2).Address

Evidemment, il y a des considérations de mise en forme qui ne sont pas prises ici.
D'ailleurs, il faudra que tu t'expliques un peu mieux à ce sujet.
De la même manière que l'on a forcé la formule de somme, on peut forcer la mise en forme.

Encore merci, je vais tester ça de suite.

Juste pour repréciser mes changements de configuration.

Officiellement, je comptais utiliser la ligne MATERIEL comme ligne de référence. Mais je me suis aperçu que j'avais des formules à calculer dans les lignes que je comptais ajouter par la suite. J'ai donc créé ces 2 lignes vierges avec les formules dans les cellules concernées (dans les colonnes "H, J, L, N") en espérant qu'en insérant les lignes en dessous, les formules s'incrémentent...

Peut-être est-il plus simple d'indiquer directement à la ligne insérée, les formules à intégrer aux cases concernées ? Solution que tu sembles me proposer dans ta macro.

Désolé si une nouvelle fois je n'ai pas été assez précis.

Pour la mise en forme, je veux dire que certains paramètres comme la couleur de fond de la cellule étaient conservés par contre les lignes insérées n'avaient pas toutes des bordures mais il me semble que j'ai réussi à le rectifier.

Je vais adapter et tester ton code et je donne des nouvelles...

Merci.

Oki.

Effectivement, je te conseille de tout faire par VBA, surtout que nous sommes dans le forum VB  

Autant pour les formules des colonnes H, J, L et N, que pour la mise en forme.

Alors si je récapitule, dans ma feuille "Devis" pour le bloc MATERIEL, je ne conserve que la ligne qui sert de référence (celle qui contient le mot MATERIEL).

A partir de la condition, j'insère l'ensemble des lignes concernées et je copie les cellules qui m'intéressent. J'insère également les formules aux cellules souhaitées.

En bas de ces lignes, j'insère une ligne qui va me permettre de calculer un pourcentage à partir d'une somme calculée sur les lignes précedentes (concerne 2 celulles).

J'insère enfin une dernière ligne dans laquelle j'intègre des sommes calculées sur les lignes précédentes pour certaines cellules (concerne 7 cellules).

Dernier point, il faudra que je pense à intégrer le format des cellules lors de l'insertion des lignes.

J'ai comme l'impression que le chemin s'est rallongé.

Je vais commencer à voir comment je peux organiser tout ça. Merci de m'indiquer si cette démarche est la bonne.

2e solution :

Je reposte une macro précédemment réalisée qui nous avait laissée croire que la fin était proche.

Option Explicit

 
Sub Devis()

 
Dim cel_source As Range

Dim cel_cible  As Range

 
Set cel_cible = Worksheets("Devis").Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

    If cel_cible Is Nothing Then

    MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

    Exit Sub

    End If

 
For Each cel_source In Worksheets("Prix matière").Range("I3:I122")

    If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

    Set cel_cible = cel_cible.Offset(1)

    cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

 
    cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value   'B --> B

    cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value   'C --> G

    cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value   'D --> H

    cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value    'E --> I

    cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value    'F --> J

    cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value    'G --> M

    cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value    'K --> O

    End If

Next

 
End Sub

Cette macro est satisfaisante si j'ai bien une ligne vierge intégrée en dessous MATERIEL. Les lignes insérées conservent le même format.

Les seuls soucis sont :
- la non incrémentation des formules tirées de la ligne "vierge" --> comment indiquer dans cette macro quelle formule appliquée pour les cellules concernées ? (--> avec la dernière macro proposée, je devrais m'en rapprocher).
- la ligne vierge qui est conservée tout au long de la macro et qui reste donc en pied de bloc à la fin de l'éxécution

Quelle solution choisir ?

Un problème n'a pas toujours qu'une solution, c'est à toi de décider.

Supprime-là - Rows(x).Delete, où cache-là - Rows(x).Hidden = True.

Effectivement je me doutais que les deux solutions étaient envisageables.

Mais je n'ai sûrement pas les connaissances suffisantes pour juger de la solution la plus simple ou plus efficace contrairement aux personnes compétentes qui participent activement à ce forum. Et je les en remercie une nouvelle fois.

Voici le code :

Option Explicit

 
Sub Devis()

 
Dim cel_source As Range

Dim cel_cible  As Range

Dim row_vide   As Range

 
Set cel_cible = Worksheets("Devis").Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

    If cel_cible Is Nothing Then

        MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

        Exit Sub

    End If

 
For Each cel_source In Worksheets("Prix matière").Range("I3:I122")

    If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

        Set cel_cible = cel_cible.Offset(1)

        cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

 
        cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value   'B --> B

        cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value   'C --> G

        cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value   'D --> H

        cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value    'E --> I

        cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value    'F --> J

        cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value    'G --> M

        cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value    'K --> O

        cel_cible.Offset(, 6).Formula = "=cel_cible.Offset(,3)*cel_cible.Offset(,5)"

    End If

Next

 
Set row_vide = cel_cible.Offset(1)

row_vide.EntireRow.Delete

 
End Sub

Ce code supprime correctement la ligne vierge. --> Merci

Reste ensuite à gérer l'incrémentation des formules... Existe-t-il un moyen de l'incrémenter lors de l'insertion et copie de la cellule précédente (au-dessus) ?
Méthode qui me semble la plus simple.
Ou alors indiquer pour les lignes insérées les formules à intégrer dans les cellules souhaitées.

EDIT : j'ai réédité le message en insérant une des formules que je souhaiterais intégrer (voir ligne 27) au cas où l'insertion avec l'incrémentation n'est pas possible. Actuellement, il me met une erreur dans la cellule correspondante et lorsque je clique sur la case, la formule n'est pas calculée et il est affiché "=cel_cible.Offset(,3)*cel_cible.Offset(,5)".

' // !!

Set row_vide = cel_cible.Offset(1)

row_vide.EntireRow.Delete

Attention à tes noms de variables. Tu définis row_vide comme une cellule, pas comme une ligne.

' // Version longue 1

Set cel_reference_ligne_vide = cel_cible.Offset(1)

cel_reference_ligne_vide.EntireRow.Delete

 
' // Version longue 2

Set row_vide = cel_cible.Offset(1).EntireRow

row_vide.Delete

 
' // master cut

cel_cible.Offset(1).EntireRow.Delete

Pour copier tes formules, il faut te faire une liste de tes cellules et voilà :

For Each cell In cellules_à_remplir_des_formules_du_dessus

    cell.FormulaR1C1 = Range("E6").Offset(-1).FormulaR1C1

Next

Alors j'ai contourné le problème pour certaines formules avec le code ci-dessous :

Sub Devis_materiel()

 
Dim cel_source As Range

Dim cel_cible  As Range

Dim row_vide   As Range

Dim cell       As Range

 
Set cel_cible = Worksheets("Devis").Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

    If cel_cible Is Nothing Then

        MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

        Exit Sub

    End If

 
For Each cel_source In Worksheets("Prix matière").Range("I4:I123")

    If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

        Set cel_cible = cel_cible.Offset(1)

        cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

 
        cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value   'B --> B

        cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value   'C --> G

        cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value   'D --> H

        cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value    'E --> I

        cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value    'F --> J

        cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value    'G --> M

        cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value    'K --> O

        cel_cible.Offset(, 6).Copy Destination:=cel_cible.Offset(1, 6)

        cel_cible.Offset(, 7).Copy Destination:=cel_cible.Offset(1, 7)

        cel_cible.Offset(, 8).Copy Destination:=cel_cible.Offset(1, 8)

        cel_cible.Offset(, 10).Copy Destination:=cel_cible.Offset(1, 10)

        cel_cible.Offset(, 11).Copy Destination:=cel_cible.Offset(1, 11)

        cel_cible.Offset(, 12).Copy Destination:=cel_cible.Offset(1, 12)

    End If

Next

 
cel_cible.Offset(1).EntireRow.Delete

 
End Sub

Dernier souci, entre la dernière ligne insérée et celle qui comprend les différents totaux, j'ai donc une ligne dans laquelle j'ai certaines cellules qui ont comme formule =SOMME(C2:C2)*B3 ou =SOMME(C2)*B3. Je ne parviens pas à rédiger la formule pour qu'elle se calcule sur l'ensemble des lignes insérées.

cel_cible.Offset(, 6).Copy Destination:=cel_cible.Offset(1, 6)

M'ouais... C'est juste que c'est plus joli comme ça :

cel_cible.Offset(1, 6).FormulaR1C1 = cel_cible.Offset(0, 6).FormulaR1C1

Parce que ça ne copie que la formule, et pas le reste, notamment la mise en forme. Pis 6 fois la même chose, c'est beaucoup :

For Each j In Array(6, 7, 8, 10, 11, 12)

    cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1

Next

(Si tu trouves que je pinaille, c'est normal   ...   )

Pour tes formules, les dernières lignes de ce code ne te conviennent-elles pas ?

Tu ne pinailles pas, tu embellis   Magnifique le code avec Array.

Je m'excuse pour la demande sur la formule avec SOMME, car j'étais effectivement en train d'adapter ce code dont je me souvenais mais j'avais anticipé un problème car avec moi les choses ne sont jamais évidentes.

Toujours est-il qu'à l'heure actuelle le code marche parfaitement.

Voici le code :

Sub Devis_materiel()

 
Dim cel_source As Range

Dim cel_cible  As Range

Dim row_vide   As Range

Dim cell       As Range

Dim lig_matos  As Range

Dim lig_somme  As Range

Dim j          As Variant

 
Set cel_cible = Worksheets("Devis").Columns(2).Find("MATERIEL", searchdirection:=xlPrevious)

    If cel_cible Is Nothing Then

        MsgBox "Impossible de trouver MATERIEL.", vbCritical Or vbOKOnly

        Exit Sub

    End If

 
For Each cel_source In Worksheets("Prix matière").Range("I4:I123")

    If cel_source.Value <> 0 Or cel_source.Offset(, 1).Value <> 0 Then

        Set cel_cible = cel_cible.Offset(1)

        cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

 
        cel_cible.Offset(, 0).Value = cel_source.Offset(, -6).Value   'B --> B

        cel_cible.Offset(, 1).Value = cel_source.Offset(, -2).Value   'C --> G

        cel_cible.Offset(, 2).Value = cel_source.Offset(, -1).Value   'D --> H

        cel_cible.Offset(, 3).Value = cel_source.Offset(, 0).Value    'E --> I

        cel_cible.Offset(, 4).Value = cel_source.Offset(, 1).Value    'F --> J

        cel_cible.Offset(, 5).Value = cel_source.Offset(, 4).Value    'G --> M

        cel_cible.Offset(, 9).Value = cel_source.Offset(, 6).Value    'K --> O

 
        For Each j In Array(6, 7, 8, 10, 11, 12)

             cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1

        Next

    End If

Next

 
Set lig_matos = Worksheets("Devis").Columns(2).Find("MATERIEL").EntireRow

Set lig_somme = cel_cible.Offset(2).EntireRow

lig_somme.Cells(8).Formula = "=SUM(" & Worksheets("Devis").Range(lig_matos.Offset(1), lig_somme.Offset(-1)).Columns(8).Address & " )*" & lig_somme.Cells(7).Address

 
cel_cible.Offset(1).EntireRow.Delete

 
End Sub

Je ne devrais pas tarder à clore ce sujet si aucune remarque n'est faite pour optimiser ce code et si la finalisation se passe dans de "bonnes conditions".

Je vous remercie de votre aide et je n'oublie pas l'autre macro en cours de réalisation sur un autre sujet.

Des remerciements plus prononcés pour "zeb" qui m'a assisté tout au long de ce topic.

 

------------------

Tu aimes ça les Array ?

Tiens, remplace tes lignes 22 à 28 :

Dim x As Variant
' //                  B --> B       C --> G       D --> H       E --> I      F --> J      G --> M      K --> O
For each x in Array(Array(0, -6), Array(1, -2), Array(2, -1), Array(3, 0), Array(4, 1), Array(5, 4), Array(9, 6))
    cel_cible.Offset(, x(0)).Value = cel_source.Offset(, x(1)).Value
Next

Pis indente moi la ligne 31 ....   ....