XL 2010 Modification code couper coller

[Lionel CIMA]

Bonjour à toutes et à tous,

Pouvez-vous m'aider à corriger ce code.
Son principe : il doit me permettre de couper / coller les lignes d'un fichier source vers un fichier destination sous condition placée en colonne C
Si la condition est remplie, la ligne entière doit être déplacée vers le fichier destination et supprimée sur le fichier source

Voici le code rédigé :

Sub Export()
    Dim i As Long
    Dim j As Long
    Application.ScreenUpdating = False
    Set WBSource = Workbooks("Test")
    Set WBDest = Workbooks("COPTEST")
    WBSource.Activate
    For i = Cells(Rows.Count, "c").End(xlUp).Row To 2 Step -1
    j = WBDest.Worksheets(1).Range("C65536").End(xlUp).Row + 1
        If Range("c" & i) Like "Deplac*" Then Rows(i).Cut Destination:=WBDest.Worksheets(1).Cells(j, 1)
    Next i
    On Error Resume Next
    Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Ce code coupe bien la ligne si elle contient "Déplacé" mais elle supprime aussi toutes les autres alors et ça ça ne va pas du tout...

Merci pour votre aide.

 

[pierrejean]

Bonjour Lionel
A tester:

Sub Export()
Dim i As Long
Dim j As Long
Application.ScreenUpdating = False
Set WBSource = Workbooks("Test")
Set WBDest = Workbooks("COPTEST")
WBSource.Activate
For i = Cells(Rows.Count, "c").End(xlUp).Row To 2 Step -1
j = WBDest.Worksheets(1).Range("C65536").End(xlUp).Row + 1
If Range("c" & i) Like "Deplac*" Then Rows(i).Cut Destination:=WBDest.Worksheets(1).Cells(j, 1)
Rows(i).Delete
Next i
' On Error Resume Next
' Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

 

[Lionel CIMA]

Merci beaucoup Pierre Jean,

Les lignes sont déplacées avec ta proposition mais toutes celles qui ne contiennent pas le terme "Déplacé" sont supprimées dans le fichier source...

Je ne comprends pas pourquoi...

 

[pierrejean]

Re
Peux-tu poster un fichier exemple (une copie du tien avec quelques lignes anonymisées ) ?

 

[Lionel CIMA]

Oui, voici les fichiers

 

[Lionel CIMA]

J'ai trouvé une solution, j'ignore si c'est optimal mais ça semble aller :

j'ai modifié la ligne de code de suppression ainsi :

If Range("c" & i) Like "Deplac*" Then Rows(i).Cut Destination:=WBDest.Worksheets(1).Cells(j, 1)
If Range("c" & i) = "" Then Rows(i).Delete

Je reste vraiment très étonné que le code précédent supprimait toutes les lignes qu'elles contiennent ou non le mot clé...

 

[pierrejean]

Re
Voila l'explication
C'est le piège de l'absence du end if
remplacer

If Range("c" & i) Like "Deplac*" Then Rows(i).Cut Destination:=WBDest.Worksheets(1).Cells(j, 1)
Rows(i).Delete

par

If Range("c" & i) Like "Deplac*" Then
Rows(i).Cut Destination:=WBDest.Worksheets(1).Cells(j, 1)
Rows(i).Delete
End if

Ta solution n'est valable que si des lignes n'ont pas "c" & i vide bien que n'ayant pas eu de "Deplac*"

 

[Lionel CIMA]

Merci beaucoup pour l'explication, un collègue m'avait bien dit que l'on pouvait compter sur la communauté en cas de difficultés.

Je vais modifier le code comme précisé.

Bon week-end.