[XL-2010] Insertion de lignes selon un nombre copié [Résolu]

[adidu44]

Bonjour,

Je reviens vers vous avec une problématique.

Sur un document j'ai plusieurs lignes et j'aimerai copié la dernière ligne saisie ainsi que toutes celles qui possèdent la même valeur en ("D5").

J'ai déjà la macro pour copier la dernière ligne :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub Bouton15_Cliquer()
 
Dim c As Range, Dest As Variant
Dest = Array("B5", "C5", "C5", "D5")
NbColonnes = 4
Set c = Range("A" & [A65536].End(xlUp).Row).Resize(1, NbColonnes)
For t = 1 To NbColonnes
    c.Cells(t).Copy Destination:=Workbooks("Exemple.xlsm").Sheets("Feuil2").Range(Dest(t - 1))
Next t
    Sheets("Feuil2").Select
    Range("B5:C5:D5").Select
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
 
End Sub

La dernière ligne est copiée vers une autre feuille mais celle-ci ne possède qu'une seule ligne d'insertion.

Je voudrais savoir si il était possible de tester la valeur de la cellule ("D5") de la dernière ligne avec les autres lignes du dessus.
De copier toutes celles égalent vers l'autre feuille en insérant autant de ligne que nécessaire.

J'espère m'être bien exprimé sur mon problème.

Cordialement,

Adidu44

[jfontaine]

Bonjour,

Si je comprend, tu veux copier toutes les lignes qui ont en colonne D la même valeur que la colonne D de la dernière ligne !

Si c'est bien cela, une solution serait d'utiliser les filtres et de copier les lignes filtrées

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim shSource As Worksheet
Dim shCible As Worksheet
 
Set shSource = Sheets("Feuil1")
Set shCible = Sheets("Feuil2")
 
'Filtre les données correspondant à la dernière ligne
shSource.Rows(1).AutoFilter
shSource.Rows(1).AutoFilter Field:=4, Criteria1:=shSource.Range("D" & shSource.Range("G65536").End(xlUp).Row).Value
 
'Sélection et copie des lignes filtrées
shSource.Range("A1").CurrentRegion.Select
Selection.Copy
'Collage dans la feuille cible
 
shCible.Range("A1").PasteSpecial
'Suppression du filtre
 
shSource.Rows(1).AutoFilter

[adidu44]

Bonjour,

Merci pour votre réponse.

J'ai modifié un petit peu votre code pour l'intégrer à un autre macro que j'ai faite.

Code :

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
27
28
 
Dim c As Range, Dest As Variant
Dim shSource As Worksheet
Dim shCible As Worksheet
 
Set shSource = Sheets("Tableau")
Set shCible = Sheets("TEST MEP")
 
'Filtre les données correspondant à la dernière ligne
shSource.Rows(1).AutoFilter
shSource.Rows(1).AutoFilter Field:=4, Criteria1:=shSource.Range("D" & shSource.Range("D65536").End(xlUp).Row).Value
 
'Sélection et copie des lignes filtrées
shSource.Range("E2").CurrentRegion.Select
Selection.Copy
 
'Collage dans la feuille cible
shCible.Range("K6").PasteSpecial
 
Dest = Array("B5", "G4:H4", "D5", "B7:D7", "C11", "D11", "E11", "F11", "C9:D9", "G11", "F8:F9", "H8:H9", "C8:D8", "C8:D8", "G6:H6")
NbColonnes = 15
Set c = Range("A" & [A65536].End(xlUp).Row).Resize(1, NbColonnes)
For t = 1 To NbColonnes
    c.Cells(t).Copy Destination:=Workbooks("Exemple.xlsm").Sheets("TEST MEP").Range(Dest(t - 1))
Next t
 
'Suppression du filtre
shSource.Rows(1).AutoFilter

Elle me permet de récupérer toute la dernière ligne que je sème dans les cellules nécessaire de la deuxième feuille.
Il faudrait juste avec votre macro que je récupère le paquet filtré de cellule entre les colonnes E et J et le coller en K6 en ajoutant autant de ligne que nécessaire avant la copie.

Tout cela est il réalisable ?

Cordialement,

Adidu44

[jfontaine]

Comme cela?

Code :

1
2
3
4
5
'Sélection et copie des lignes filtrées
shSource.Range("E2:J" & shSource.Range("E65536").End(xlUp).Row).Copy
 
'Collage dans la feuille cible
shCible.Range("K6").PasteSpecial

[adidu44]

Parfait, cela copie le paquet désiré.

Est il possible de calculer le nombre de lignes copiés et d'insérer le nombre de lignes égal au nombre de lignes copiées à la suite de la ligne K afin de pouvoir y placer tout le paquet ?

Car j'ai d'autres informations en dessous de ces lignes.

Cordialement,

Adidu44

[jfontaine]

Je pense que le mieux serait de faire une insertion des données

Code :

1
2
'Collage dans la feuille cible
shCible.Range("K6").Insert Shift:=xlDown

[adidu44]

Tout cela est parfait.

Merci beaucoup pour votre temps et votre aide qui m'a été précieuse.

Cordialement,

Adidu44