Recopier bloc de données sur une autre page avec conditions

Le 04/11/2013 à 10:51

Bonjour à tous,

J'ai sur une feuille des listes de données que je souhaite recopier (et effacer) vers une autre feuille suivant une condition.

J'ai déjà trouvé des sujets parlant de ça sur ce forum mais je n'ai réussi à correctement adapter le code:

Exemple1:

'' Passage FI en cours à FI soldées

Private Sub CommandButton1_Click()
' Boucle de lecture de la colonne N de la feuille "FI en cours"
' Lire chaque cellule ("cel" est un nom de variable qui représente la cellule en cours de lecture)
For Each cel In Sheets("FI en cours").Range("N:N")
  ' Teste le contenu de la cellule
  ' Pour éviter les différences de caractères, on transforme le contenu de "cel" en majuscules (UCase)
  If UCase(cel.Value) = "OK" Then
    ' Si le contenu de "cel" est égal à "OK" alors on effectue les instructions contenues ente If Then et End If
    With Sheets("FI soldée")
    ' Les références de cellules précédées d'un point s'appliquent à la feuille "restitution"
      ' On affecte à la variable "lg" le numéro de la 1ère ligne vide en colonne N de la feuille "FI soldée"
      ' Pour ce faire, on remonte du bas de la feuille ("N65536") jusqu'à la dernière cellule remplie ("End(xlUp).Row")
      ' et on ajoute 1 pour obtenir le numéro de la ligne vide située en-dessous
      lg = .Range("N65536").End(xlUp).Row + 1
      ' Boucle de lecture des colonnes A à M de la feuille "suivi véhicule"
      For cl = 1 To 8
        ' On affecte la valeur de la cellule lue à la cellule homonyme de la feuille "restitution"
        .Cells(lg, cl) = Sheets("FI en cours").Cells(cel.Row, cl)
        ' puis on efface la cellule lue sur la feuille "FI en cours"
        For c2 = 4 To 7
        Sheets("FI en cours").Cells(cel.Row, c2) = ""
        Next
      Next
    End With
  End If
Next
End Sub

Exemple2:

Option Explicit

Sub Filtre()
    Range("O2") = "N2=""ok"""
    Range("A2:m" & Range("B65000").End(xlUp).Row).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
    Range("O1:O2"), CopyToRange:=Sheets("FI soldés").Range("A1:N1"), Unique:=False
    Range("O2").ClearContents
End Sub

Je mets les 2 exemples en PJ

Merci à vous et bonne journée !

Le 04/11/2013 à 12:52

Bonjour

Ce serait plus facile si tu mettais un fichier en ligne avec le tableau final attendu

Amicalement

Le 04/11/2013 à 13:07

Bonjour Dan,

Effectivement c'est plus lisible avec le résultat attendu, fichier en PJ

Le 05/11/2013 à 08:12

Bonjour,

Le fichier n'est pas passé

Le 05/11/2013 à 08:20

Aie désolé, erreur de manip :/

Le 05/11/2013 à 13:04

Re,

A la vue de ton fichier, il y a des cellules fusionnées ce qui en code n'est jamais bon. Tôt au tard cela provoque toujours des bug ou des difficultés dans la gestion du code.

Il faudrait trouver idéalement en colonne A les mots fiche1, 2... sur chaque ligne. Iden pour le mot Ok en colonne L

Mais on peut rester comme cela aussi

Que se passe-t-il si l'information est déjà présente en feuille "FIsoldee" ?

Exemple :

mettons qu'un "Ok" est déjà présent en L2, donc info de Fiche1 (J1 à J6) présente en FIsoldee

on ajoute un "ok" en L8, que devra faire le code, ajouter Fiche1 et fiche2 en dessous ou ajouter uniquement Fiche2 ??

Le 05/11/2013 à 13:09

Re,

J'ai un peu modifié le code et ça passe plus ou mois: j'arrive à copier ligne par ligne. C'est à dire que quand ma fiche 1 est terminée, je mets un ok de L2 à L7.

  • La copie se fait sans problème.
  • Ensuite je vide mes colonne 4 à 7 et 12 (en fait sur mon vrai fichier il y'a des formules sur les autre colonnes donc je les laisses)

Ce que je souhaite faire c'est un transfert par paquet: si je met "ok" en L2 c'est tout mon bloc A2:L7 que se copie, pas de ok à chaque ligne.

Pour les cellules fusionnées ça à l'air de bien marcher pour l'instant.

Mon nouveau code:

'' Passage FI en cours à FI soldées

Private Sub CommandButton1_Click()
' Boucle de lecture de la colonne L de la feuille "suivi véhicule"
' Lire chaque cellule ("cel" est un nom de variable qui représente la cellule en cours de lecture)
' Cette boucle ne lit que les cellules qui contiennent une valeur (SpecialCells(xlCellTypeConstants))
For Each cel In Sheets("FI en cours").Range("L:L").SpecialCells(xlCellTypeConstants)
  ' Teste le contenu de la cellule
  ' Pour éviter les différences de caractères, on transforme le contenu de "cel" en majuscules (UCase)
  If UCase(cel.Value) = "OK" Then
    ' Si le contenu de "cel" est égal à "OK" alors on effectue les instructions contenues ente If Then et End If
    With Sheets("FI soldées")
      ' Les références de cellules précédées d'un point s'appliquent à la feuille "restitution"
      ' On affecte à la variable "lg" le numéro de la 1ère ligne vide en colonne L de la feuille "restitution"
      ' Pour ce faire, on remonte du bas de la feuille ("B65536") jusqu'à la dernière cellule remplie ("End(xlUp).Row")
      ' et on ajoute 1 pour obtenir le numéro de la ligne vide située en-dessous
      lg = .Range("L65536").End(xlUp).Row + 1
      ' Boucle de lecture des colonnes A à D de la feuille "suivi véhicule"
      For cl = 1 To 12
        ' On affecte la valeur de la cellule lue à la cellule homonyme de la feuille "FI soldées"
        .Cells(lg, cl) = Sheets("FI en cours").Cells(cel.Row, cl)
      Next
      ' puis on efface la ligne lue sur la feuille "FI en cours"
      For c2 = 4 To 7
       Sheets("FI en cours").Cells(cel.Row, c2) = ""
      Next
      Sheets("FI en cours").Cells(cel.Row, 12) = ""
    End With
  End If
Next
End Sub
Le 05/11/2013 à 13:49

Re

essaie comme ceci :

Private Sub CommandButton1_Click()
Dim i As Integer, lg As Integer
For i = 1 To Sheets("FI en cours").Range("L" & Rows.Count).End(xlUp).Row Step 6
    If UCase(Range("L" & i + 1)) = "OK" Then
        With Sheets("FI soldée")
        lg = .Range("B65536").End(xlUp).Row + 1
        Range("A" & i + 1 & ":L" & i + 6).Copy .Range("A" & lg)
        Sheets("FI en cours").Range("D" & i + 1 & ":G" & i + 6).ClearContents
        Sheets("FI en cours").Range("L" & i + 1).ClearContents
      End With
    End If
Next
End Sub

Attention que FI Soldée est écrite autrement le ton code ci-avant. Le mieux serait de nommer les feuilles sans espace et accent. Ex : FI_soldee et FI_en_Cours

Si ok, clique sur le V vert à coté du bouton EDITER pour cloture le fil lors de ta réponse

Cordialement

Le 05/11/2013 à 14:01

Re Dan,

Merci pour ton aide. Effectivement j'ai modifié 'FI soldée' par 'FI soldées'. J'ai donc fais la modif sur le code.

Malheureusement ça ne fonctionne pas totalement:

  • l'effacement des cellules se fait très bien
  • mais la copie ne se fait pas
Le 05/11/2013 à 16:32

re

l'effacement des cellules se fait très bien

Il faut effacer quoi dans FI en cours ?? de D à L ??

Le code supprime de D à G et l'info en colonne L

mais la copie ne se fait pas

dans la version du fichier mise sur le site, cela fonctionne.

Verifie les noms de feuille

eventuellement , mets le bon fichier en ligne

Le 05/11/2013 à 18:36

Re,

Oui la copie se fait sur mon fichier en ligne, j'ai fais une erreur de manip. Mea culpa ^^

Merci beaucoup pour ta grande, tu me retires une épine du pied !

Encore merci et à bientôt

Le 06/11/2013 à 08:53

Re Dan,

Je me permets de te renvoyer un message à cause d'une nouvelle erreur. J'ai essayé d'adapter ton code sur un autre fichier.

La seule modification est le nom d'une feuille: 'FI soldée' devient 'FI soldées'. J'ai donc remplacer le nom qui va bien dans le code.

Lorsque que j'active la macro j'ai une erreur d'excéution 1004 qui m'indique la copy range à échouée.

Private Sub CommandButton1_Click()
Dim i As Integer, lg As Integer
For i = 1 To Sheets("FI en cours").Range("L" & Rows.Count).End(xlUp).Row Step 6
    If UCase(Range("L" & i + 1)) = "OK" Then
        With Worksheets("FI soldées")
        lg = .Range("B65536").End(xlUp).Row + 1
        Range("A" & i + 1 & ":L" & i + 6).Copy .Range("A" & lg) '''' ligne qui se surligne en jaune
        Sheets("FI en cours").Range("D" & i + 1 & ":G" & i + 6).ClearContents
        Sheets("FI en cours").Range("L" & i + 1).ClearContents
      End With
    End If
Next
End Sub

En te remerciant pour ton aide et bonne journée

Le 07/11/2013 à 12:55

re,

Déso mais je n'étais pas revenu sur le fil puisque cloturé. Je l'ai décloturé (un click sur le V devenu rouge permet de remettre la cse à cocher en vert.

Pour le code, cela fonctionne bien de mon coté.

Questions :

  • Le code est bien dans la feuille FI EN COURS
  • Vérifie bien les espaces entre les caractères (comme dit dans mon précédent post, il vaut mieux ne jamais mettre d'espaces dans les noms de feuilles...

si pas ok, envoie moi le vrai fichier en ligne en enlevant les données confidentielles

Amicalement

Le 07/11/2013 à 13:37

Bonjour Dan,

Entre temps j'ai utilisé la manière brutale: tout refaire et ça fonctionne bien. Il devait y'avoir quelquechose qui n'allait pas et que je n'ai malheureusement pas vu ^^.

Merci pour ton aide et bonne aprem !

Rechercher des sujets similaires à "recopier bloc donnees page conditions"