Ne copier/coller que certaines colonnes selon une condition

  • Auteur de la discussion GTmacrodeb
  • Date de début

GTmacrodeb

Expert
Bonjour à toute la communauté,

Je viens vers vous car je souhaite avoir des précisions pour améliorer ce code que je vous propose.

[cpp]
Option Explicit

Sub linecopy(ByVal line As Range, ByRef Target As Range, Optional clear As Boolean) '// nouvelle variable

Dim ws_prix_m As Worksheet

Set ws_prix_m = Worksheets("Prix matière")

line.EntireRow.Copy Destination:=Target
Set Target = Target.Offset(1)

End Sub


Sub Devis()

Dim ws_prix_m As Worksheet
Dim ws_devis As Worksheet
Dim plage_destination As Range
Dim i As Long
Dim j As Long

Set ws_prix_m = Worksheets("Prix matière")
Set plage_destination = Worksheets("Devis").Rows(1) 'Feuille vierge 1ère ligne
Set ws_devis = Worksheets("Devis")

For i = 3 To 23
For j = 7 To 8
If ws_prix_m.Cells(i, j).Value <> 0 Then
linecopy ws_prix_m.Rows(i), plage_destination, True
End If

Next
Next

End Sub[/cpp]

1- Ce code est clairement à optimiser mais avant de finaliser ma base de données, je souhaite déjà savoir ce qu'il est possible de réaliser. C'est pour cela que la macro est appliquée jusqu'à la ligne 23.

2- Je pense avoir déclaré dés variables inutilement mais je ne parviens pas à rédiger la fonction If (ligne29) autrement. Ce que je souhaiterais c'est sélectionner la ligne à partir du moment où la cellule G ou H est différente de 0.

3- Pour l'instant, les lignes sont copiées sur une nouvelle feuille dès la 1ère ligne. Par la suite, je souhaiterais que les lignes se copient dans un document existant.
Comment indiquer en macro la ligne à partir de laquelle il peut copier ? Dans mon cas, je souhaiterais qu'il commence à copier en dessous d'une ligne qui contient le mot "MATERIEL" en colonne A.
Comment intégrer le nombre de lignes correspondant au nombre de lignes sélectionnées ?

4- Le tableau dans lequel je souhaite copier ces lignes a une structure différente. Est-il possible de sélectionner uniquement certaines colonnes selon la condition et de les coller dans un ordre différent ?

Merci d'avance pour votre aide à tous.


GTmacrodeb.
 

zeb

Modérateur
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 :
Code:
Option Explicit
Code:
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 :
Code:
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.
Code:
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
Code:
Set cel_cible = Worksheets("Devis" ).Rows(1)
 

GTmacrodeb

Expert
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.
 

zeb

Modérateur
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 :
Code:
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 :
Code:
worksheets(x).Range("nom_de_la_cellule")
 

GTmacrodeb

Expert
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
 

GTmacrodeb

Expert
Donc voici le code actuellement et qui fonctionne.

[cpp]
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
[/cpp]

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.
 

zeb

Modérateur
Ahhhhhhhh :)

Juste un petit truc : juste après la ligne 6, vérifie que quelque chose a bien été trouvé. On ne sait jamais :
Code:
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
Code:
Rows("8:8").Select
Selection.Insert Shift:=xlDown
Beurk. A traduire en :
Code:
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 :
Code:
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
 

GTmacrodeb

Expert
Encore merci pour les conseils. Voici le code :

[cpp]
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
[/cpp]

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.
 

zeb

Modérateur
Arggghhhhh x_X :fou: :fou: :fou:
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

Code:
'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 :whistle:
Code:
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 :
Code:
cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown
Set newline = cel_cible.Offset(2).EntireRow

Code:
Range("H:J", "L:N" )
Non, non et non. Il faudrait écrire
Code:
Range("H:J,L:N" )
Mais ça ne peut pas marcher.

Pour créer ta zone, plusieurs solutions :
Code:
' // 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.
 

GTmacrodeb

Expert
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 :

[cpp]
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[/cpp]

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"...
 

zeb

Modérateur
Je ne t'aide plus si tu ne m'indentes pas correctement ton code. :fou:

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.
 

GTmacrodeb

Expert
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.
 

zeb

Modérateur
Oki. C'est clair pour moi maintenant.
Pour l'intentation, c'est presque ça (lignes 12 & 34 [:zeb:4] ) :lol:

Code:
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
 

GTmacrodeb

Expert
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 :
[cpp]
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[/cpp]

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.
 

zeb

Modérateur
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.

Code:
' // 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.
 

GTmacrodeb

Expert
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.
 

zeb

Modérateur
Oki.

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

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

GTmacrodeb

Expert
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.
 

GTmacrodeb

Expert
2e solution :

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

[cpp]
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[/cpp]

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 ?
 

zeb

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

- 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
Supprime-là - Rows(x).Delete, où cache-là - Rows(x).Hidden = True.
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 132
Messages
6 718 005
Membres
1 586 388
Dernier membre
mery2005
Partager cette page
Haut