Couper/coller d'un tableau à un autre via une valeur

[glm]

Bonjour à tous et toutes
Je recherche à couper une plage du tableau2 du fait de la valeur de la colonne C = "F" (dans feuille "liste complète") puis insérer dans le tableau9 sur la dernière ligne (dans la feuille "Fait")
Merci
voici le code:
For i = [A5000].End(xlUp).Row To 10 Step -1
If Left(Cells(i, 3), 3) = "F" Then
Set PLgL1 = Rows(i).Copy
Sheets("Fait").Select
Set PLgL2 = ActiveSheet.ListObjects("Tableau9").ListRows.Add.Range
PLgL1.Paste
PLgL1.Delete
End If
Next i

 

[CPk]

Re : Couper/coller d'un tableau à un autre via une valeur

Bonjour, je n'ai pas regardé l'intégralité du code, le début m'intrigue..

If Left(Cells(i, 3), 3) = "F" Then

cette expression ne sera jamais vrai (3 caractères > 1 caractère)
il faudrait plutôt essayer left(cells(i,3),1) = "F"

 

[glm]

Re : Couper/coller d'un tableau à un autre via une valeur

Bonjour
désolé, je relance le sujet
Cdt

 

[glm]

Re : Couper/coller d'un tableau à un autre via une valeur

Bonjour
je suis triste
je suis bloqué sur ce sujet et cette macro
Merci de votre soutien

 

[job75]

Re : Couper/coller d'un tableau à un autre via une valeur

Bonsoir glm, CPK,

Une remarque préliminaire : la ligne 232 en 1ère feuille et la ligne 594 en 3ème feuille sont vides.

Elles appartiennent aux tableaux Excel, supprimez-les pour être cohérent.

Ensuite vous pouvez utiliser cette macro :

Sub Sup_Lig()
'Feuil1 et Feuil3 sont les CodeNames des feuilles
Dim i As Long, P As Range
Application.ScreenUpdating = False
Feuil1.Unprotect 'est-ce bien nécessaire ?
With Feuil1.ListObjects(1).Range
  For i = .Rows.Count To 2 Step -1
    If .Cells(i, 3) = "F" Then
      Set P = .Rows(i)
      With Feuil3.ListObjects(1).Range
        .Rows(.Rows.Count + 1) = P.Value 'copie les valeurs
      End With
      P.Delete
    End If
  Next
End With
Feuil1.Protect 'est-ce bien nécessaire ?
Feuil3.Activate 'facultatif
End Sub

Edit : s'il y a un grand nombre de "F", le couper-coller n'est pas une bonne méthode car c'est très lent.

Il faudrait utiliser des tableaux VBA, beaucoup plus rapides.

Bonne soirée.

 

[job75]

Re : Couper/coller d'un tableau à un autre via une valeur

Bonjour,

On aura remarqué que les lignes se créent en Feuil3 dans l'ordre inverse de celles en Feuil1, c'est normal.

Si l'on veut qu'elles se créent dans le même ordre utiliser :

Sub Sup_Lig()
'Feuil1 et Feuil3 sont les CodeNames des feuilles
Dim lig As Long, i As Long, P As Range
Application.ScreenUpdating = False
Feuil1.Unprotect 'est-ce bien nécessaire ?
lig = Feuil3.ListObjects(1).Range.Rows.Count + 1 'mémorisation
With Feuil1.ListObjects(1).Range
  For i = .Rows.Count To 2 Step -1
    If .Cells(i, 3) = "F" Then
      Set P = .Rows(i)
      With Feuil3.ListObjects(1).Range
        .Rows(lig).Insert 'insertion de ligne
        .Rows(lig) = P.Value 'copie les valeurs
      End With
      P.Delete
    End If
  Next
End With
Feuil1.Protect 'est-ce bien nécessaire ?
Feuil3.Activate 'facultatif
End Sub

C'est encore moins rapide puisqu'on insère des lignes.

A+

 

[job75]

Re : Couper/coller d'un tableau à un autre via une valeur

Re,

Notez qu'on peut toujours utiliser la macro du post #5 si à la fin on ajoute un tri de Feuil3 :

Sub Sup_Lig()
'Feuil1 et Feuil3 sont les CodeNames des feuilles
Dim i As Long, P As Range
Application.ScreenUpdating = False
Feuil1.Unprotect 'est-ce bien nécessaire ?
With Feuil1.ListObjects(1).Range
  For i = .Rows.Count To 2 Step -1
    If .Cells(i, 3) = "F" Then
      Set P = .Rows(i)
      With Feuil3.ListObjects(1).Range
        .Rows(.Rows.Count + 1) = P.Value 'copie les valeurs
      End With
      P.Delete
    End If
  Next
End With
Feuil1.Protect 'est-ce bien nécessaire ?
With Feuil3.ListObjects(1).Range
  .Sort .Columns(2), xlAscending, Header:=xlYes 'tri croissant sur les dates
End With
Feuil3.Activate 'facultatif
End Sub

Cela dit dans votre fichier en colonne B il n'y a pas toujours des dates...

A+

 

[glm]

Re : Couper/coller d'un tableau à un autre via une valeur

Bonsoir
désolé de ne pas avoir répondu tout de suite.
Merci à tous, cela fonctionne parfaitement