Résolu macro recopie de ligne [Résolu]

Keny84120

Nouveau membre
Bonjour à tous,

-néo-fit dans la programmation en Visual basic, je cherche a écrire une macro pour excel qui:

Recopier les 3 première ligne d'en tête de la page "Suivi des écarts" sur la page "Rapport des écarts";
puis dans la page "Suivi des écarts"
si "X" dans la colonne "I" (à partir de la ligne 4) recopier la ligne à la suite (donc à partir de la ligne 4) dans la page "Rapport des écarts";
si "Ø" dans la colonne "I" (à partir de la ligne 4) ne rien faire
end

-J'ai trouvé un sujet similaire et j'ai essayer d'adapter à mon fichier:

Sub Report_des_écart()

'
' Report_des_écart Macro
'
' Touche de raccourci du clavier: Ctrl+r
'
Dim cel As Range 'déclaration d'une variable pour la boucle de type range
Dim source As Range 'déclaration d'une variable qui servira de source pour la copie de donnée

Worksheets("Rapport des écarts").UsedRange.Clear 'On vide complètement la feuille de destination
Set source = Sheets("Suivi des écarts").Range("A1:J3").EntireRow 'Initialisation de source avec l'entête de la feuille source

With Sheets("Suivi des écarts") 'toute les commande commancant par "." se référeront automatiquement à Sheets("Suivi des écarts") à l'intérieur du with
For Each cel In .Range("I4:I" & .Range("I" & .Rows.Count).End(xlUp).Row) 'on boucle sur toutes les cellules de I4 à la dernière cellule occupée de la colonne I
If cel.MergeCells Then 'si la cellule est fusionnée
Set source = Union(source, cel.MergeArea.EntireRow) 'on rajoute les lignes fusionnées à la source
ElseIf cel.Value = X Then 'si le contenu de cel est égal à "X"
Set source = Union(source, cel.EntireRow) 'alors on rajoute les lignes fusionnées à la source
End If 'fin de si
Next 'prochain élément de la boucle
End With ' fin du with

source.Copy Worksheets("Rapport des écarts").Range("A1") 'on copie d'un coup toutes les cellule qu'on n'a mis dans source
Worksheets("Rapport des écarts").Activate 'On active la feuille "Rapport des écarts" (optionnel)
Worksheets("Rapport des écarts").Range("A1").Select 'Et on sélectionne la case A1 (la aussi optionnel)
End Sub


-quand j'utilise cette macro ça ne fonctionne pas, par contre si je remplace le X par 1 et du coup je rentre 1 dans la colonne I ça fonctionne, comment faire pour utilisé le "X"?
-de temps en temps la macro bloque sur :
source.Copy Worksheets("Rapport des écarts").Range("A1") 'on copie d'un coup toutes les cellule qu'on n'a mis dans source
mais je sais pas pourquoi?

Merci par avance à tous ceux que prendront le temps de me lire

PS: j'avais préparé un fichier pour test mais le format .xlsx ne passe pas si vous savez pourquoi je joindrais volontiers le fichier test
 

svoglimacci

check memory failed but no bug detected
Salut :)
PS: j'avais préparé un fichier pour test mais le format .xlsx ne passe pas si vous savez pourquoi je joindrais volontiers le fichier test
On ne le lira pas ;) Ce genre de fichier peut présenter un risque (surtout via les macros).
Pour tes parties de code, utilise sur la barre supérieure le déroulant "..." + Code, c'est plus lisible.
-quand j'utilise cette macro ça ne fonctionne pas, par contre si je remplace le X par 1 et du coup je rentre 1 dans la colonne I ça fonctionne, comment faire pour utilisé le "X"?
Ton X doit être entre guillemets, c'est du texte. D'ailleurs, je ne comprends pas pourquoi il a accepté ton X sans guillemets.
-de temps en temps la macro bloque sur :
source.Copy Worksheets("Rapport des écarts").Range("A1") 'on copie d'un coup toutes les cellule qu'on n'a mis dans source?
Je ne sais pas, je ne maîtrise pas les finesses de l'arborescence d'objets de Excel.
Perso je suis un vrai bourrin progressif : je prends deux indices, un i pour la feuille d'origine, un j pour la feuille de destination, et si la cellule est bonne, je copie / colle la ligne. Avec les incrémentations de i et j qui vont bien. Et ensuite je remplace (lentement mais sûrement) par du plus élégant, si je le trouve. Bien sûr, si je savais manipuler ces jolies choses (à 1 macro par an ce n'est pas gagné) je ferais comme toi.

Toutefois, quelques conseils :
Dim source As Range
...
Set source = Sheets("Suivi des écarts").Range("A1:J3").EntireRow 'Initialisation de source avec l'entête de la feuille source
Le nom "source" n'est pas cool pour un tableau intermédiaire. Ce n'est pas ta "source", ta source est la première page ;) D'ailleurs, l'exemple mis en gras le prouve, la ligne de commentaire est peu lisible.
En règle générale, les variables doivent avoir un nom bien parlant. Comme "Dim cel As Range 'déclaration d'une variable pour la boucle de type range ", le nom est (pour moi) incompréhensible, mais peut-être me gourre-je.

source.Copy Worksheets("Rapport des écarts").Range("A1") 'on copie d'un coup toutes les cellule qu'on n'a mis dans source
...
Worksheets("Rapport des écarts").Activate 'On active la feuille "Rapport des écarts" (optionnel)
Worksheets("Rapport des écarts").Range("A1").Select 'Et on sélectionne la case A1 (la aussi optionnel)
Mets le nom de tes deux feuilles dans une variable, en haut du code. Sinon tu vas pleurer en cas de changement.

Dans le genre "je n'ai rien compris mais c'est sûrement parceque je suis un naze" :
If cel.MergeCells Then 'si la cellule est fusionnée
Fusionnée ? Pourquoi ?
If cel.MergeCells Then 'si la cellule est fusionnée
Set source = Union(source, cel.MergeArea.EntireRow) 'on rajoute les lignes fusionnées à la source
ElseIf cel.Value = X Then 'si le contenu de cel est égal à "X"
Set source = Union(source, cel.EntireRow) 'alors on rajoute les lignes fusionnées à la source
End If 'fin de si
Vu de loin, je ne comprends pas : pourquoi on lit deux fois "union" ? J'aurais cru que ça serait plutôt "si condition ok" union, sinon rien.

Désolé de ne pas pouvoir en faire plus. Il y a un mutant, @drul, qui parle mieux le vba excel que le français, il pourra faire bien mieux :)
 

drul

Obscur pro du hardware
Staff
Déplacé le topic au bon endroit :)

Alors quelques complément:

- Utiliser Union est très joli en théorie, mais excel ne parvient pas à copier des cellules non contiguë, du coup c'est bof ... (raison probable de la plantée de ta macro lors de la copie). En conclusion copie ligne par ligne ... (c'est plus lent, mais ça marche à tous les coups)
- Met au début de ta macro (avant le sub): "Option Explicit", cela te forcera à déclarer tes variables, (c'est plus propre, et évite l'erreur du X, et les fautes de frappes)
- Pour le truc des "merged cell", tu en as besoin ? (as-tu des cellule "fusionnée" dans ton classeur ? Le mec qui a pondu ça (moi je suppose) doit être plutôt tordu :D ...

A Plus

@svoglimacci: merci pour le mutant, je te revaudrai ça !
 

svoglimacci

check memory failed but no bug detected
D'ailleurs, je ne comprends pas pourquoi il a accepté ton X sans guillemets.
Met au début de ta macro (avant le sub): "Option Explicit", cela te forcera à déclarer tes variables, (c'est plus propre, et évite l'erreur du X, et les fautes de frappes)
Pffff. C'a m'apprendra à n'avoir utilisé que des langages à obligation de déclaration.
Merci l'extraterrestre :D
 

drul

Obscur pro du hardware
Staff
Aller E.T. est de bonne :D

Code:
Option Explicit
Sub Report_des_écart()

'
' Report_des_écart Macro
'
' Touche de raccourci du clavier: Ctrl+r
'
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim i As Long
Dim lastCell As Long
Dim targetCel As Range

Set srcSheet = Sheets("Suivi des écarts")
Set dstSheet = Sheets("Rapport des écarts")

dstSheet.UsedRange.Clear 'On vide complètement la feuille de destination
srcSheet.Range("1:3").Copy dstSheet.Range("A1") ' on copie les en-têtes
Set targetCel = dstSheet.Cells(4, "A") 'on commencera à copier les données ici

lastCell = srcSheet.Cells(Rows.Count, "I").End(xlUp).Row 'on cherche la dernière cellule de la colonne I dans srcSheet

For i = 4 To lastCell '(on boucle sur toutes les cellules de I depuis la ligne 4
    If srcSheet.Cells(i, "I").Value = "X" Then
       srcSheet.Cells(i, "I").EntireRow.Copy targetCel
       Set targetCel = targetCel.Offset(1, 0)
    End If
Next

dstSheet.Activate 'On active la feuille "Rapport des écarts" (optionnel)
dstSheet.Range("A1").Select 'Et on sélectionne la case A1 (la aussi optionnel)

End Sub

Une version simplifiée du code que tu devrais pouvoir comprendre, facilement modifiable
 

Keny84120

Nouveau membre
Merci beaucoup pour toutes ces informations, Je vais regarder tous ça et je vous renvoie ma macro définitive commentée.
 

Keny84120

Nouveau membre
Bonjour, Encore Merci pour l'aide,
voici la macro tel que je la comprend:
Code:
Dim srcSheet As Worksheet 'détermine la variable srcSheet comme une page
Dim dstSheet As Worksheet 'détermine la variable dstSheet comme une page
Dim i As Long 'la variable "i" comprend toute la colonne
Dim lastCell As Long 'la variable "lastCell" comprend toute les cellule pleine
Dim targetCel As Range 'la variable "targetCel" est une sélection

Set srcSheet = Sheets("Suivi des écarts") 'la page "suivi des écarts" devient la variable "srcSheet"
Set dstSheet = Sheets("Rapport des écarts") 'la page "rapport des écarts" devient la variable "dstSheet"

dstSheet.UsedRange.Clear 'On vide complètement la feuille de destination
srcSheet.Range("1:3").Copy dstSheet.Range("A1") ' on copie les en-têtes
Set targetCel = dstSheet.Cells(4, "A") 'on commencera à copier les données ici

lastCell = srcSheet.Cells(Rows.Count, "I").End(xlUp).Row 'on cherche la dernière cellule de la colonne I dans srcSheet

For i = 4 To lastCell 'on boucle sur toutes les cellules de I depuis la ligne 4
    If srcSheet.Cells(i, "I").Value = "X" Then 'si on trouve "X" dans la colonne I sur scrSheet...
       srcSheet.Cells(i, "I").EntireRow.Copy targetCel 'copier la ligne entière à partir de la cellule cible
       Set targetCel = targetCel.Offset(1, 0) 'incrémenter la cellule cible d'une ligne (pas français)
    End If
    If srcSheet.Cells(i, "I").Value = "x" Then         'j'ai rajouter ce Bloc parceque je ne suis pas seul
       srcSheet.Cells(i, "I").EntireRow.Copy targetCel 'à utiliser le fichier et je voulais que ça marche
       Set targetCel = targetCel.Offset(1, 0)          'avec ou sans Majuscule
    End If
Next

dstSheet.Activate 'On active la feuille "Rapport des écarts" (optionnel)
dstSheet.Range("A1").Select 'Et on sélectionne la case A1 (la aussi optionnel)

End Sub
 

drul

Obscur pro du hardware
Staff
Meilleure réponse
Re,

Code:
    If srcSheet.Cells(i, "I").Value = "X" Then 'si on trouve "X" dans la colonne I sur scrSheet...
       srcSheet.Cells(i, "I").EntireRow.Copy targetCel 'copier la ligne entière à partir de la cellule cible
       Set targetCel = targetCel.Offset(1, 0) 'incrémenter la cellule cible d'une ligne (pas français)
    End If
    If srcSheet.Cells(i, "I").Value = "x" Then         'j'ai rajouter ce Bloc parceque je ne suis pas seul
       srcSheet.Cells(i, "I").EntireRow.Copy targetCel 'à utiliser le fichier et je voulais que ça marche
       Set targetCel = targetCel.Offset(1, 0)          'avec ou sans Majuscule
    End If

inutile de faire 2 tests, tu as au moins 3 possibilités pour l'éviter:

1°) If (srcSheet.Cells(i, "I").Value = "X") or (srcSheet.Cells(i, "I").Value = "x") Then
Assez lourd, double accès à la cellule, pas très compact, mieux que 2 IF, mais bof

2°) If UCase(srcSheet.Cells(i, "I").Value) = "X" Then
Déjà bien mieux, on force la casse de la Cellule en majuscule et on compare

3°) If srcSheet.Cells(i, "I").Value like "[xX]" Then
Ma préférée, l'opérateur like est juste d'une souplesse et d'une puissance phénoménale !

 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 058
Membres
1 586 285
Dernier membre
LeFront
Partager cette page
Haut