Discussion :

[jawed]

salut tous le monde encors une foix j'ai besoin de vos lumiere
j'ai deux feuille excel dans le meme claseur
dans la feuille 1 "Pointage" figure des données avec des sous totos.
la feuille 2 "NEcart" est vide
je veut si c'est possible :
1- lorsque je selectionne les lignes voulu avec leur sous total de la feuille "Pointage"
2- je coupe ses données
3- je colle ses données dans la feuille 2 "NEcart"
4- je suprime les lignes vide de la feuille 1 " Pointage"
lorsque je reselctionne des nouveux données de la feuille 1 "Pointage" il execute les conditions 2+3+4 mais il transpose ses nouveaux données sous le dernier sous total qui existe dans la feuille 2 "NEcart"
cordialement
a bientot

Bonjou tous le monde
J'ai éssayé ce code mais il ecrase les nouveux données sur les enciens en prenant en cosidiration que les lignes de 2 a 9

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Transfert()
    Rows("2:9").Select
    Selection.Cut
    Sheets("NEcart").Select
    ActiveSheet.Paste
    Sheets("Pointage").Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
End Sub

quelqu'un peut corrigé ce probleme merci
cordialement

[Abed_H]

Bonjour jawed
essaie ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub Transfert()
    ActiveSheet.Rows("2:9").Select
    Selection.Copy Destination:=Sheets("NEcart").Range("A65536").End(xlUp)(2)
    ActiveSheet.Rows("2:9").Delete Shift:=xlUp
End Sub

Bonne journée et à bientôt.

[jawed]

Merci Abed_H
toujours au secour des plus faible
ton code marche trés bien mais il prend en considiration que les ligne de 2 a 9 mais beaucoup de sous toto dépasse les huit lignes exemple le 2° sous toto en a 10 alors si je veut le transposé dans feuille NEcart il me renvois que les 8 premiere lignes au lieu des dix
j'espaire etre plus claire
merci et a bientot
cordialement

[Abed_H]

Re
essaie ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub Transfert()
derli = Range("A2").SpecialCells(xlCellTypeBlanks).Row
    ActiveSheet.Range("A2:A" & derli).EntireRow.Select
    Selection.Copy Destination:=Sheets("NEcart").Range("A65536").End(xlUp)(3)
    ActiveSheet.Range("A2:A" & derli).EntireRow.Delete Shift:=xlUp
End Sub

Bonne journée

[jawed]

bonjour Abed_H
que dire c'est parfait
peut on amelioré ce code en trasférant que les sous toto selectionné de feuille Pointage exemple si en selectionne un sous toto au milieu il transfert ce dernier pas le premier sous toto
encors bravo
codialement

[Abed_H]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If ActiveCell.Formula Like "=SUBTOTAL*" Then
       ActiveCell.Copy
       Sheets("NEcart").Range("D65536").End(xlUp)(2).PasteSpecial _
              Paste:=xlPasteValues
     End If

Bonne chance jawed