XL 2013 Fonction pour trouver la dernière ligne

Roseline

XLDnaute Occasionnel
Bonjour,
J'ai une commande VBA qui me permet d'enlever des lignes dans un onglet et de les envoyer automatiquement dans un autre dès que j'inscrit le mot terminé dans une cellule.
Ma commande cherche donc la dernière ligne de mon autre onglet et transpose les données à cet endroit là.
Mon interrogation, je voudrais que lorsque je sélectionne l'option "terminé", ma ligne complète s'enlève de mes 25 premières lignes et aille s'ajouter à la dernière ligne des lignes 26 à 36 de dossiers finalisés mais dans le même onglet

Je m'explique: Mon onglet est divisé de cette manière…..
Dossier en cours : 25 premières lignes
Dossiers finalisés: 26 à 36 lignes suivantes
Total des dépenses les 37 à 40 dernières lignes du fichier

Voici mon sub que j'ai actuellement pour envoyer dans un autre onglet et qui fonctionne parfaitement mais je suis incapable de l'adapter pour que les données reste dans le même onglet mais s'insère dans la plage de dossiers finalisés des lignes 26 à 36.

Sub termine() 'Transfert les dossiers réglés

Dim motcle
Dim I As Byte
Dim c As Range
Dim F As String
Dim ligne As Long

'On définit les mots clés
motcle = Array("terminé")

'on effectue la recherche de chaque mot clé dans la colonne I de la feuille "xxxx"
For I = 0 To UBound(motcle)
Do
Set c = Worksheets("xxx").Columns(9).Find(motcle(I), LookIn:=xlValues, lookat:=xlPart)

'si le mot clé est trouvé
If Not c Is Nothing Then

'on définit le nom de la feuille où sera effectué la copie
F = "yyy" '& (I + 2)
With Worksheets(F)

'enlever les filtres s'il y a lieu
If .FilterMode = True Then .ShowAllData

'on définit la ligne ou sera effectué le collage
ligne = .Range("A" & Rows.Count).End(xlUp).Row + 1


'on effectue le copier/coller
c.EntireRow.Copy .Range("A" & ligne)

'on supprime la ligne dans la feuille xxx
c.EntireRow.Delete


End With

End If
Loop While Not c Is Nothing
Next I

End Sub

Merci encore de votre précieuse aide.
 

job75

XLDnaute Barbatruc
Bonjour Roseline,

Essayez cette macro :
VB:
Sub Couper()
Dim i%, j%
For i = 1 To 25
    If Cells(i, 9) = "terminé" Then
        For j = 26 To 36
            If Application.CountA(Rows(j)) = 0 Then Rows(i).Cut Cells(j, 1): Exit For
        Next j
    End If
Next i
End Sub
A+
 

Roseline

XLDnaute Occasionnel
Bonjour Roseline,

Essayez cette macro :
VB:
Sub Couper()
Dim i%, j%
For i = 1 To 25
    If Cells(i, 9) = "terminé" Then
        For j = 26 To 36
            If Application.CountA(Rows(j)) = 0 Then Rows(i).Cut Cells(j, 1): Exit For
        Next j
    End If
Next i
End Sub
A+
Bonjour, wow Merci ça fonctionne parfaitement et la ligne se transpose au bon endroit. Cependant elle laisse une ligne vide à l'endroit initial et je ne trouve pas comment faire pour annuler cette ligne vide. Avez-vous une idée pour moi? Merci encore
 

job75

XLDnaute Barbatruc
Bonsoir Roseline,

Si l'on supprime la ligne coupée il faut décaler la 2ème plage vers le bas :
VB:
Sub Couper()
Dim i%, j%
For i = 25 To 1 Step -1
    If Cells(i, 9) = "terminé" Then
        For j = 26 To 36
            If Application.CountA(Rows(j)) = 0 Then
                Rows(i).Cut Cells(j, 1)
                Rows(26).Insert 'décale la 2ème plage vers le bas
                Rows(i).Delete 'supprime la ligne coupée
                Exit For
            End If
        Next j
    End If
Next i
End Sub
A+
 

Roseline

XLDnaute Occasionnel
Bonsoir Roseline,

Si l'on supprime la ligne coupée il faut décaler la 2ème plage vers le bas :
VB:
Sub Couper()
Dim i%, j%
For i = 25 To 1 Step -1
    If Cells(i, 9) = "terminé" Then
        For j = 26 To 36
            If Application.CountA(Rows(j)) = 0 Then
                Rows(i).Cut Cells(j, 1)
                Rows(26).Insert 'décale la 2ème plage vers le bas
                Rows(i).Delete 'supprime la ligne coupée
                Exit For
            End If
        Next j
    End If
Next i
End Sub
A+
Bonjour,
 

Roseline

XLDnaute Occasionnel
Bonjour, Cela fonctionne parfaitement, je vous remercie beaucoup.
J'ai ajouté une commande pour trier par la suite ma colonne A en ordre alphabétique mais elle ne fonctionne pas, est-ce qu'il me manque quelque chose:

ActiveWorkbook.Worksheets("xxx").Sort.SortFields.Add Key:=Range( _
"A34:a41"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("xxxx").Sort
.SetRange Range("A12:BG41")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
 

Roseline

XLDnaute Occasionnel
Bonsoir Roseline,

Nous il nous manque le fichier...

A+
Rebonjour,
Mon fichier est trop gros et contient vraiment trop de renseignements confidentiels pour le partager. J'ai fait plusieurs recherche et j'ai finalement trouvé ce qui me manquait.
Je vous remercie beaucoup de votre précieuse aide.
Bonne journée à vous
Bonjour Roseline,

Vous croyez que c'est une bonne idée de mettre votre post #7 comme solution de cette discussion ???

A+
Rebonjour,
Loin de là mon intention de vous fâcher, je voulais simplement mentionner que la solution que vous m'avez fournie dans ma première demande était parfaite et fonctionnait à merveille. :(
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 794
Membres
101 817
dernier inscrit
carvajal