Déplacer une ligne sur une autre feuille si cellule remplie

Bonjour à tous,

Le forum m'a déjà aidé, je reviens du coup vers vous pour un autre soucis.

Je ne connais rien en VBA et je me sers de code trouver sur le web pour faire mon fichier.

Le soucis que j'ai ici est que j'aimerais qu'en appuyant sur le bouton "Archiver" toute les lignes qui contiennent une date dans la colonne "Effectuer le" soient déplacée vers la deuxième feuille nommée "Histo".

Mais je ne trouve pas de code qui dit "si cette cellule est remplie je déplace la ligne vers".

J'espère avoir été assez clair, j'ai eu du mal a trouver les mots pour le décrire.

je joins mon fichier.

EDIT : un autre petit soucis aussi mais rien a voir avec le VBA, quand je trie mon tableau par date croissante ou décroissante, les tailles des lignes ne sont plus adaptées et du coup du texte est caché, comment faire pour mettre a jour les hauteur de lignes après un tri ?

Merci d'avance

Bonjour Antrax, bonjour le forum,

Pour ton premier problème essaie comme ça :

Sub Macro1()
Dim I As Worksheet 'déclare la variable I (onglet Interventions)
Dim H As Worksheet 'déclare la variable H (onglet Histo)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set I = Worksheets("Interventions") 'définit l'onglet I
Set H = Worksheets("Histo") 'définit l'onglet H
TV = I.Range("A4").CurrentRegion 'définit le tableau des valeurs TV (il commence en A3 et la première valeur est à sa 4ème ligne)
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For J = 4 To NL 'boucle 1 : sur toutes les lignes J du tableau des valeurs TV (en partant de la 4ème)
    If TV(J, 8) <> "" Then 'condition : si la donnée ligne I colonne 8 (=> "Efectuer le") n'est pas vide
        ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
        For L = 1 To NC 'boucle 2 :  sur toutes les colonnes du tableau des valeurs TV
            TL(L, K) = TV(J, L) 'récupère dans la ligne L de TL, la valeur de la donnée en colonne L de TV (=transposition)
        Next L 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est égale à 1 (au moins une occurence "Effectué le" trouvée)
    Set DEST = H.Range("A" & Application.Rows.Count).End(xlUp) 'définit la cellule de destination DEST
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If 'fin de la condition
End Sub

C'est génial merci :p

Il est possible de rajouter que ce qui a été déplacé soient supprimer du premier tableau ?

Edit : quand je clique plusieurs fois sur Archiver pour voir si le tableau Histo se remplit bien, il insère les nouvelles lignes en dessous des autres sauf qu'il écrase la dernière ligne qui était déja archivée.

Edit 2 : j'ai essayer en rajoutant .Row + 1 dans le code mais ça ne fonctionne pas.

If K > 1 Then 'condition : si K est égale à 1 (au moins une occurence "Effectué le" trouvée)
       Set DEST = H.Range("A" & Application.Rows.Count).End(xlUp).Row + 1 'définit la cellule de destination DEST
       DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé

Bonjour Antrax, bonjour le forum,

J'avoue que j'ai du mal a coder avec les tableaux. J'ai pas encore assimiler. Le code modifié :

Sub Macro1()
Dim I As Worksheet 'déclare la variable I (onglet Interventions)
Dim H As Worksheet 'déclare la variable H (onglet Histo)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim PL As Range 'déclare la variable PL (PLage)

Set I = Worksheets("Interventions") 'définit l'onglet I
Set H = Worksheets("Histo") 'définit l'onglet H
Set PL = I.Range("A1") 'initialise la variable PL
TV = I.Range("A4").CurrentRegion 'définit le tableau des valeurs TV (il commence en A3 et la première valeur est à sa 4ème ligne)
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For J = 4 To NL 'boucle 1 : sur toutes les lignes J du tableau des valeurs TV (en partant de la 4ème)
    If TV(J, 8) <> "" Then 'condition : si la donnée ligne I colonne 8 (=> "Efectuer le") n'est pas vide
        Set PL = IIf(PL.Cells.Count = 1, I.Rows(J + 2), Application.Union(PL, I.Rows(J + 2))) 'définit la variable PL
        ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
        For L = 1 To NC 'boucle 2 :  sur toutes les colonnes du tableau des valeurs TV
            TL(L, K) = TV(J, L) 'récupère dans la ligne L de TL, la valeur de la donnée en colonne L de TV (=transposition)
        Next L 'prochaine colonne de la boucle 2
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est égale à 1 (au moins une occurence "Effectué le" trouvée)
    Set DEST = IIf(H.Range("A4") = "", H.Range("A4"), H.Range("A3").End(xlDown).Offset(1, 0)) 'définit la cellule de destination DEST
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If 'fin de la condition
PL.EntireRow.Delete 'efface la plage PL
End Sub

Bonjour ThauTheme

Ton code fonctionne maintenant correctement pour la copie des lignes dans la deuxième feuille.

Mais la ligne " PL.EntireRow.Delete " ne fonctionne pas

Quand je la supprime il n'y a plus aucun soucis, juste la suppression des lignes ne se font pas vu que c'était son but.

Si tu as une solution ce serait génial, tu m'a déjà beaucoup aidé, je te remercie.

Bonsoir Antrax, bonsoir le forum,

Oui désolé, la variable PL représente déjà des lignes entières. Donc PL.Delete suffit...

ThauThème a écrit :

Bonsoir Antrax, bonsoir le forum,

Oui désolé, la variable PL représente déjà des lignes entières. Donc PL.Delete suffit...

Rebonsoir ThauThème,

J'obtiens la même erreur qu'avec PL.EntireRow.Delete

Bonsoir Antrax, bonsoir le forum,

Je ne comprends plus rien. Dans la V6 ça marchait mais comme je n'avais pas utilisé la macro deux fois de suite, je n'avais pas vu qu'ensuite, si il n'y avait plus aucun "Effectué le", ça effaçait la ligne 1. J'ai donc modifié le code qui fonctionne très bien dans la V6 mais pas dans la V7. Miss Terre et Bulldog home...

Sub Archiver()
Dim I As Worksheet 'déclare la variable I (onglet Interventions)
Dim H As Worksheet 'déclare la variable H (onglet Histo)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim PL As Range 'déclare la variable PL (PLage)

Set I = Worksheets("Interventions") 'définit l'onglet I
Set H = Worksheets("Histo") 'définit l'onglet H
Set PL = I.Range("A1") 'initialise la variable PL
TV = I.Range("A4").CurrentRegion 'définit le tableau des valeurs TV (il commence en A3 et la première valeur est à sa 4ème ligne)
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For J = 4 To NL 'boucle 1 : sur toutes les lignes J du tableau des valeurs TV (en partant de la 4ème)
   If TV(J, 8) <> "" Then 'condition : si la donnée ligne I colonne 8 (=> "Efectuer le") n'est pas vide
       Set PL = IIf(PL.Cells.Count = 1, I.Rows(J + 2), Application.Union(PL, I.Rows(J + 2))) 'définit la variable PL
       ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
       For L = 1 To NC 'boucle 2 :  sur toutes les colonnes du tableau des valeurs TV
           TL(L, K) = TV(J, L) 'récupère dans la ligne L de TL, la valeur de la donnée en colonne L de TV (=transposition)
       Next L 'prochaine colonne de la boucle 2
       K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
   End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est égale à 1 (au moins une occurence "Effectué le" trouvée)
   Set DEST = IIf(H.Range("A4") = "", H.Range("A4"), H.Range("A3").End(xlDown).Offset(1, 0)) 'définit la cellule de destination DEST
   DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If 'fin de la condition
If PL.Cells.Count > 1 Then PL.Delete 'efface la plage PL
End Sub

J'ai toujours la même erreur, il me surligne PL.Delete en mode débogage.

J'ai pourtant remplacer tout le code du module3 par celui que tu viens de me donner.

Quand tu l'insère toi dans le fichier il fonctionne ?

Désolé de te prendre de ton temps.

Bonjour Antrax, bonjour le forum,

En pièce jointe ta version 6 avec le dernier code qui est devenu 6 bis. Elle fonctionne (chez moi).

Bonjour Thauthème

Je viens de l'essayer, j'ai effacer toute les entrées du tableau de la page Histo et ça a fonctionné. il a bien copié et supprimé de la première page.

j'ai entré ensuite de nouvelle date la colonne "Effectuer le" et recliquer sur archiver, et là j'ai eu la même erreur qu'hier "la méthode delete de la classe range a échoué"

Si cette ligne de code pose problème il y a peut être moyen de faire une autre macro qui détecte elle aussi les cellules remplies de la colonne "effectuer le" mais qui elle effacera la ligne de celle-ci.

Pour pouvoir cliquer sur "Archiver" et ensuite un autre bouton "Supprimer" par exemple.

Si ça t'ennuie ne t'inquiète pas tu m'as déjà fort aidé et je ne voudrais pas abusé de ton temps.

Bonne journée.

Edit : je viens de me rendre compte que j'ai mis sur mon profil que j'ai office 2010 mais c'est le 2016, cela aurait-il une incidence ?

Bonjour Antrax, bonjour le forum,

Je ne comprends pas, chez moi pas de bug. Essaie ce nouveau code. On pourrais faire avec une seule boucle mais tu aurais les données inversées (dernière ligne en premier) dans Histo. J'ai donc fait deux boucles :

Sub Archiver()
Dim I As Worksheet 'déclare la variable I (onglet Interventions)
Dim H As Worksheet 'déclare la variable H (onglet Histo)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (Nombre de Colonnes)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim PL As Range 'déclare la variable PL (PLage)

Set I = Worksheets("Interventions") 'définit l'onglet I
Set H = Worksheets("Histo") 'définit l'onglet H
Set PL = I.Range("A1") 'initialise la variable PL
TV = I.Range("A4").CurrentRegion 'définit le tableau des valeurs TV (il commence en A3 et la première valeur est à sa 4ème ligne)
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
K = 1 'initialise la variable K
For J = 4 To NL 'boucle 1 : sur toutes les lignes J du tableau des valeurs TV (en partant de la 4ème)
  If TV(J, 8) <> "" Then 'condition : si la donnée ligne I colonne 8 (=> "Efectuer le") n'est pas vide
      Set PL = IIf(PL.Cells.Count = 1, I.Rows(J + 2), Application.Union(PL, I.Rows(J + 2))) 'définit la variable PL
      ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL
      For L = 1 To NC 'boucle 2 :  sur toutes les colonnes du tableau des valeurs TV
          TL(L, K) = TV(J, L) 'récupère dans la ligne L de TL, la valeur de la donnée en colonne L de TV (=transposition)
      Next L 'prochaine colonne de la boucle 2
      K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
  End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1
If K > 1 Then 'condition : si K est égale à 1 (au moins une occurence "Effectué le" trouvée)
  Set DEST = IIf(H.Range("A4") = "", H.Range("A4"), H.Range("A3").End(xlDown).Offset(1, 0)) 'définit la cellule de destination DEST
  DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If 'fin de la condition
Application.ScreenUpdating = False
For J = NL + 2 To 6 Step -1 'boucle inversée des lignes NL+2 à 6
  If I.Cells(J, 8) <> "" Then I.Rows(J).Delete
Next J 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True
End Sub

Re,

Génial celui fonctionne !

Juste pourquoi la date 02-10-2016 deviens 10-02-2016 en allant dans l'onglet histo ?

Merci beaucoup

Bonjour Antrax, bonjour le forum,

Désolé, j'ai fait plusieurs essais et je n'y arrive pas. Je n'utilise jamais les "tableaux" et de fait, je cale...

ThauThème a écrit :

Bonjour Antrax, bonjour le forum,

Désolé, j'ai fait plusieurs essais et je n'y arrive pas. Je n'utilise jamais les "tableaux" et de fait, je cale...

Bonjour ThauThème,

J'ai cherché un peu sur internet pourquoi excel inverse le jour et le mois, d'après ce que j'ai compris quand une date passe par du VBA il considère que si le premier chiffre est inférieur à 12 c'est lui le mois (il le mettrais au format anglo-saxon) si il est supérieur il ne change pas puisqu'il n'y a pas plus de 12 mois dans une année. Enfin je crois... moi et le code ça fait deux

J'ai vu pas mal de sujet sur des forums avec des gens qui ont le même soucis de date inversée et a chaque fois la fonction CDate(Range revient sur la table, mais je ne vois pas comment intégrer cette fonction a ton code. Ou peut-être qu'il faut l'appliquer a la plage de cellule des colonnes de date sur les deux feuilles.

Je dis ça comme si c'était facile alors que ça ne l'est surement pas.

Peut-être qu'en créant un nouveau sujet sur ce problème spécifique il y aura plus de chance d'avoir quelqu'un ayant rencontré le soucis.

Tu m'as déjà fourni un boulot de dingue merci en tout cas.

Bonjour Antrax, bonjour le forum,

J'ai souvent rencontré ce problème en envoyant des données d'une UserForm vers les cellules et la solution est simple. Il suffit de renvoyer les dates de l'UserForm au format américain et ensuite, dans les cellules, de formater le format que l'on désire. Le résultat est nickel sans inversion.

Pour toi, j'ai essayé tout cela mais quoique je fasse ça inverse les date (quand l'inversion est possible). C'est vrai que je suis passé par un tableau dynamique pour renvoyer vers un tableau, chose que je n'avais jamais faite auparavant... Je vais essayer une autre méthode mais je ne te promets pas que ce soit fait aujourd'hui...

Re,

Si les données supprimées et reportées doivent être dans le même ordre, c'est beaucoup plus lent mais ça marche :

Sub Archiver2()
Dim I As Worksheet 'déclare la variable I (onglet Interventions)
Dim H As Worksheet 'déclare la variable H (onglet Histo)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim J As Long 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set I = Worksheets("Interventions") 'définit l'onglet I
Set H = Worksheets("Histo") 'définit l'onglet H
Set PL = I.Range("A1") 'initialise la variable PL
DL = I.Range("A" & Application.Rows.Count).End(xlUp).Row
For J = 6 To DL ' boucle sur toutes les lignes J de 6 à DL
    If I.Cells(J, 8) <> "" Then 'condition : si cellule ligne I colonne 8 (=> "Efectuer le") n'est pas vide
        Set DEST = IIf(H.Range("A4") = "", H.Range("A4"), H.Range("A3").End(xlDown).Offset(1, 0)) 'définit la cellule de destination DEST
        I.Cells(J, 1).Resize(1, 12).Copy DEST 'copie la ligne J dans dest
    End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1
For J = DL To 6 Step -1 ' boucle inversée sur toutes les lignes J de DL à 6
    If I.Cells(J, 8) <> "" Then 'condition : si cellule ligne I colonne 8 (=> "Efectuer le") n'est pas vide
        I.Rows(J).Delete 'efface la ligne J
    End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1

Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Si les données reportées peuvent être inversées (première ligne en dernier, etc...), c'est un peu plus rapide :

Sub Archiver()
Dim I As Worksheet 'déclare la variable I (onglet Interventions)
Dim H As Worksheet 'déclare la variable H (onglet Histo)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim J As Long 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set I = Worksheets("Interventions") 'définit l'onglet I
Set H = Worksheets("Histo") 'définit l'onglet H
Set PL = I.Range("A1") 'initialise la variable PL
DL = I.Range("A" & Application.Rows.Count).End(xlUp).Row
For J = DL To 6 Step -1 ' boucle inversée sur toutes les lignes J de DL à 6
    If I.Cells(J, 8) <> "" Then 'condition : si cellule ligne I colonne 8 (=> "Efectuer le") n'est pas vide
        Set DEST = IIf(H.Range("A4") = "", H.Range("A4"), H.Range("A3").End(xlDown).Offset(1, 0)) 'définit la cellule de destination DEST
        I.Cells(J, 1).Resize(1, 12).Copy DEST 'copie la ligne J dans dest
        I.Rows(J).Delete 'efface la ligne J
    End If 'fin de la condition
Next J 'prochaine ligne de la boucle 1
Application.ScreenUpdating = True 'affiche les raffraîchissements d'écran
End Sub

Bonsoir Thauthème,

Tout fonctionne bien

J'ai essayé les deux codes et j'ai pris le deuxième, je n'ai pas besoin de les avoir dans l'ordre, si je recherche quelque chose je peux trier le tableau par date ou repère dans la première colonne.

Merci beaucoup pour tout !!

Bonsoir Thauthème, Antrax et le forum,

Je viens de voir votre sujet cela fonctionne bien ,

Mais un problème sur la feuille (Histo) tableau structuré la ligne recopier est copié sous la dernière ligne mais en dehors du tableau

et quand tu veut faire un autre transfert la ligne sous le tableau est remplacer par la dernière que tu à transférer,

bonne continuation

Ferdinand