Copie multiligne et insertion

Version imprimable

Bonjour,

Désolé de vous embêter avec un problème si simple mais je ne comprend pas ou est mon erreur, :oops:

Je cherche à :
- copier des lignes triés,
- les insérer à un autre endroit.

Ça marche avec la copie mais pas avec l'insert ....

Voici mon code :

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
29
30
31
32
33
Option Explicit
Public FEE As Worksheet
'---------------------------------------------------------------------
Sub main()
 
Set FEE = ThisWorkbook.Worksheets(1)
 
Call Copiteur(FEE, "D0003", 6)
 
End Sub
'---------------------------------------------------------------------
Sub Copiteur(WKS As Worksheet, CodeACopier As Variant, ColloneATrier As Integer, Optional LigneDeDebut As Integer = 3)
 
'Je Rentre en mémoire la dernière ligne du tableau
Dim DerniereLigne As Integer
DerniereLigne = WKS.Cells(Rows.Count, 1).End(xlUp).Row
 
'Je filtre sur la feuille voulu, le code voulu dans la collone voulue
WKS.Cells.AutoFilter Field:=ColloneATrier, Criteria1:=CodeACopier
 
'Je copie les ligne encore visibles (mais pas les deux premieres ou il y a des textes d'entete
WKS.Rows(LigneDeDebut & ":" & WKS.Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
 
'Je colle les ligne copiées en fin de tableau
WKS.Rows(DerniereLigne + 1 & ":" & DerniereLigne + 1).PasteSpecial xlPasteAll ' <--- Ca ça marche
 
'J'insert les lignes copiées juste avant la dernière
WKS.Rows(DerniereLigne & ":" & DerniereLigne).Insert xlShiftDown  ' <--- Ca ça marche pas
 
'je désactive le filtre
WKS.Cells.AutoFilter
 
End Sub

09/03/2018, 10h24
Phil Free

Bonjour,

parce que la copie contient des cellules non contigus. Même à la main cela ne fonctionne pas. La preuve en est que l'option : insérer les cellules copiées
n’apparaît pas dans le menu contextuel dans ce cas de cellules non contigus.

il te faut passer par un collage dans une zone temporaire pour reprendre ensuite cette zone temporaire qui elle aura des cellules contigus.

Ou 2ieme solution que je préfère, tu prépares le collage en insérant préalablement la quantité de ligne vide qui correspond au nombre de ligne copiées.

A+
09/03/2018, 10h26
Limace_hurlante

Merci beaucoup Phil Free,

Je vais en effet insérer préalablement le bon nombre de ligne.

En revanche comment compter les lignes copiées ?
09/03/2018, 10h35
Phil Free

en ajoutant une variable :

Code:

Dim Maplage as Range

puis en ajoutant les lignes :

Code:

Set Maplage = WKS.Rows(LigneDeDebut & ":" & WKS.Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)

du coup tu peux obtenir le nombre de ligne comme ceci pour l'exemple car je vais te laisser implémenter le truc :

Code:

MsgBox Maplage.Rows.count
09/03/2018, 10h51
unparia

Bonjour
La méthode Range.copy copie parfaitement en continu, à partir de la cellule spécifiée par son paramètre destination une plage de cellules discontinues
09/03/2018, 11h39
Phil Free

Citation:

Envoyé par unparia

Bonjour
La méthode Range.copy copie parfaitement en continu, à partir de la cellule spécifiée par son paramètre destination une plage de cellules discontinues

Bonjour unparia,

oui et comme le dirait Marc-L La méthode Range.SpecialCells est superflue car la methode range.copy ne prend en compte que les cellules visible et de plus comme tu le dis si bien

Citation:

copie parfaitement en continu

Mon avis est que les gent qui viennent ici ne font pas tous l'effort d'essayer et d'apprendre avant de poster. Du coup je pense que l'on ne peu pas toujours casser les efforts de ceux qui comme Limace_hurlante et qui on travaillé leur sujet, en leurs reprochant une méthode moins bonne serte mais qui répond au besoin quand même. Mais ok je comprend déjà ta position qui est que le médiocre est l'ennemi de l'excellence. Pourtant il y bien un chemin semer d’embûches entre les deux. Et oui je suis encore sur ce chemin et ai encore beaucoup à apprendre mais je me soigne.

Amicalement

Philippe
09/03/2018, 11h58
Marc-L

Pourquoi faire compliqué quand Excel le réalise déjà simplement ?
Pourquoi proposer un code niveau expert que le demandeur ne pourra maintenir par lui-même ?
Le meilleur code n'étant pas le nôtre mais celui que le demandeur peut déjà comprendre et surtout maintenir …

Pour calculer le nombre de lignes affichées, ne pas oublier la simple fonction de feuille de calculs SOUS.TOTAL !
Juste en lisant l'aide d'Excel, à tester déjà dans une cellule … Bref, Penser Excel Avant VBA !

Merci de toutes vos réponses.

J'ai intégré la modification de unparia qui consiste à retirer

Code:

SpecialCells(xlCellTypeVisible)

Marc-L, je suis désolé mais effectivement il est important de ne pas utiliser du code qu'on ne peux pas maintenir et j'ai personnellement beaucoup de difficulté avec l'utilisation des formules "Excel" dans VBA. Le R1C1 est obscur pour moi. La proposition de Phil Free est plus "abordable" pour moi.

Phil Free, j'ai utilisé ton code et hélas

Code:

PlageCopie.Rows.Count

me rentourne le nombre de lignes, y compris les lignes masquées .... j'insert donc beaucoup trop de lignes ...
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 29 30 31 32 33 34 35 36 37 38 Option Explicit Public FEE As Worksheet '------------------------------------------- Sub main() Set FEE = ThisWorkbook.Worksheets(1) Call Copiteur(FEE, "D0003", 6) End Sub '------------------------------------------- Sub Copiteur(WKS As Worksheet, CodeACopier As Variant, ColloneATrier As Integer, Optional LigneDeDebut As Integer = 3) 'Je Rentre en mémoire la dernière ligne du tableau Dim DerniereLigne As Integer DerniereLigne = WKS.Cells(Rows.Count, 1).End(xlUp).Row 'Je filtre sur la feuille voulu, le code voulu dans la collone voulue WKS.Cells.AutoFilter Field:=ColloneATrier, Criteria1:=CodeACopier 'Je met dans un range les ligne encore visibles (mais pas les deux premieres ou il y a des textes d'entete) Dim PlageCopie As Range, NbLigneCopie As Integer Set PlageCopie = WKS.Rows(LigneDeDebut & ":" & WKS.Cells(Rows.Count, 1).End(xlUp).Row) '<- j'ai retiré SpecialCells(xlCellTypeVisible) selon vos conseils 'j'insert autant de l'igne que neccessaire au colage Rows(DerniereLigne & ":" & DerniereLigne + PlageCopie.Rows.Count - 1).Insert Shift:=xlDown 'Je copie PlageCopie.Copy 'Je colle les ligne copiées dans l'espace libéré WKS.Rows(DerniereLigne & ":" & DerniereLigne).PasteSpecial xlPasteAll ' 'je désactive le filtre WKS.Cells.AutoFilter End Sub
.

Questions subsidiaire, pensez vous que cette sub devrait plutot etre un function. Elle sera appelé d'un peu partout par mon code .
Vu que je ne lui demande aucun "retour", je ne la mets pas en function, mais j'imagine que vous le feriez ... Mais j'ignore pourquoi...

09/03/2018, 18h01
Marc-L

Comme une formule peut directement être utilisée soit nativement via Formula soit via FormulaLocal
le problème de la notation R1C1 n'en est plus un !
Rien qu'en effectuant une recherche sur ce forum vu les nombreux exemples s'y trouvant déjà,
notamment pour le very easy hyper méga super ultra simple calcul du nombre de lignes affichées via SOUS.TOTAL
(Application.SubTotal en VBA) et du reste il suffit juste de le tester déjà manuellement dans la feuille de calculs
pour appréhender ensuite son utilisation en VBA après consultation de Formula (ou encore FormulaLocal) …
Faire au moins cet "effort" niveau collégien en nous indiquant la formule une fois fonctionnelle
afin de déclencher la suite (comme déjà indiqué sur le tutoriel de la fonction RECHERCHEV) …

Si pas besoin de retour alors ce n'est pas une fonction mais juste une procédure.

Voici mon code final qui fonctionne et qui n'est pas idéal mais qui fonctionne ...

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
Public FEE As Worksheet
'__________________________________________________________________
Sub main()
 
Set FEE = ThisWorkbook.Worksheets(1)
 
Call Copiteur(FEE, "D0010", "D0022", 6)
 
End Sub
'__________________________________________________________________
Sub CopiteurDeDevis(WKS As Worksheet, CodeACopier As Variant, NouveauCode As String, ColloneATrier As Integer, Optional LigneDeDebut As Integer = 3)
 
'Je Rentre en mémoire la dernière ligne du tableau
Dim DerniereLigne As Integer
DerniereLigne = WKS.Cells(Rows.Count, 1).End(xlUp).Row
 
'Je filtre sur la feuille voulu, le code voulu dans la collone voulue
WKS.Cells.AutoFilter Field:=ColloneATrier, Criteria1:=CodeACopier
 
'Je met dans un range les ligne encore visibles (mais pas les deux premieres ou il y a des textes d'entete)
Dim PlageCopie As Range, NbLigneCopie As Integer
Set PlageCopie = WKS.Rows(LigneDeDebut & ":" & WKS.Cells(Rows.Count, 1).End(xlUp).Row) '<- j'ai retiré SpecialCells(xlCellTypeVisible) selon vos conseils
 
'j'insert autant de l'igne que neccessaire au colage
Rows(DerniereLigne & ":" & DerniereLigne + PlageCopie.Rows.Count).Insert Shift:=xlDown
 
'Je copie
PlageCopie.Copy
'Je colle les ligne copiées dans l'espace libéré
WKS.Rows(DerniereLigne & ":" & DerniereLigne).PasteSpecial xlPasteAll   '
 
'On boucle sur lles lignes copiées pour soit modifier le code devis, soit supprime les lignes vides
Dim i As Integer
For i = DerniereLigne To (DerniereLigne + PlageCopie.Rows.Count)
    If Cells(i, ColloneATrier) = CodeACopier Then Cells(i, ColloneATrier) = NouveauCode
    If Cells(i, ColloneATrier) = "" Then
        WKS.Rows(i & ":" & (DerniereLigne + PlageCopie.Rows.Count)).Delete Shift:=xlUp
        Exit For
    End If
Next i
 
'je désactive le filtre
WKS.Cells.AutoFilter
 
End Sub