code vba excel 2007, déplacer une ligne Fermé

Question

bonjour tt le monde
j'ai besoin de votre précieuse aide sur excel 
bref, j'ai un tableau de presque 1000 ligne
le problème que je  n'arrive  pas a compose le bon code vba qui me permettra de faire une recherche sur tous les cellules de  le colonne D,ne i et si il trouve une cellule qui commence par exemple de 00150, coupe toute le ligne et la déplacer a la première ligne vide de la feuille 2 
j'attends votre retour pcqe je commence a flipper
merci d'avence

f894009 · Answer

Bonjour,

code pas des plus top, mais ca marche, ici code pour un bouton sur feuille 1

Sub Bouton1_Cliquer()    With Worksheets("feuil1")        Recherche = "00150"        'derniere cellule non vid ecolonne A        derlig = .Range("A" & Rows.Count).End(xlUp).Row        'mise en memoire plage de cellules        Set Plage = .Range("D1:D" & derlig)        'nombre de fois ce qui est recherche        Nb = Application.CountIf(Plage, Recherche)        'si au moins une fois        If Nb > 0 Then            lig = 1            'boucle de recherche ligne            For x = 1 To Nb                lig = .Columns(4).Find(Recherche, .Cells(lig, 4), , xlWhole).Row                'couper ligne                .Rows(lig).EntireRow.Cut                With Worksheets("feuil2")                    .Activate                    'premiere cellule vide colonne A                    Plvid = .Range("A" & Rows.Count).End(xlUp).Row + 1                    'selection cellule A de cette ligne                    .Range("A" & Plvid).Select                    'coloage                    ActiveSheet.Paste                End With            Next x        End If    End WithEnd Sub

michel_m · Answer

Pour avoir un début de réponse il faudrait ^tre clair.... 
 
...."le colonne D,ne i et si il ..." 
désolé, mais je n'ai pas compris


Michel

Maurice · Answer

Bonjour

moi nom plus

je perfere copy que cut

Sub CopyLigne()
Application.ScreenUpdating = False
Lig = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row + 1
Nlig = Cells(Rows.Count, 1).End(xlUp).Row
   For L = Nlig To 2 Step -1
      If Cells(L, 2).Value = "00150" Then
         Rows(L).Copy
            Feuil2.Range("A" & Lig).PasteSpecial xlPasteValues
         Rows(L).Delete
         Lig = Lig + 1
      End If
   Next
With Application
   .CutCopyMode = False
   .ScreenUpdating = True
End With
End Sub


A+
Maurice

Code vba excel 2007, déplacer une ligne

3 réponses

Discussions similaires