Copie selon conditions

Le 05/08/2019 à 18:37

Bonjour,

Je recherche de l'aide pour corriger ce code que je n'arrive pas à faire fonctionner comme je souhaite :

Je souhaite que la copie de la ligne 14 (contenant 3 cellules) soit copiée si la valeur de la cellule B15 est égale à "Donnée Non Saisie" ou "Donnée Erronée"

Quelqu'un pourrait-il m'aider ?

Merci par avance

Voici le code :

Sub Archiver()

ligne = Sheets("Sauvegarde").Range("A1").End(xlDown).Row + 1
Sheets("Sauvegarde").Range("A" & ligne).Value = Sheets("Guide").Range("B5").Value 'N° Fiche
Sheets("Sauvegarde").Range("B" & ligne).Value = Sheets("Guide").Range("D10").Value 'Date du contrôle
Sheets("Sauvegarde").Range("C" & ligne).Value = Sheets("Guide").Range("D9").Value 'Contrôleur
Sheets("Sauvegarde").Range("D" & ligne).Value = Sheets("Guide").Range("D8").Value 'Type
Sheets("Sauvegarde").Range("E" & ligne).Value = Sheets("Guide").Range("B6").Value 'Num CL
Sheets("Sauvegarde").Range("F" & ligne).Value = Sheets("Guide").Range("B7").Value 'Date de réception
Sheets("Sauvegarde").Range("G" & ligne).Value = Sheets("Guide").Range("B6").Value 'Date de traitement
Sheets("Sauvegarde").Range("H" & ligne).Value = Sheets("Guide").Range("B9").Value 'Traité par

If Worksheets("Guide").Range("B14").Value = "Donnée Non Saisie" Then
Set plage = Worksheets("Sauvegarde").Range("A14:A" & Cells(Rows.Count, 2).End(xlUp).Row)
ArchiveRow = plage.SpecialCells(xlCellTypeBlanks).Cells(1, 1).Row
Worksheets("Guide").Rows(i).Copy
Worksheets("Sauvegarde").Cells(ArchiveRow, 1).PasteSpecial
End If

End Sub
Le 05/08/2019 à 21:44

Salut,

tu veux copier les céllules A14:A16 de la feuille "Sauvegarde" la valeur de la cellule B15 est égale à "Donnée Non Saisie" ou "Donnée Erronée" ?

et tu veux les coller où?

ou bien tu veux copier les céllules A14:A16 de la feuille "Guide" la valeur de la cellule B15 est égale à "Donnée Non Saisie" ou "Donnée Erronée" et les coller dans la première céllule vide de la feuille "Sauvegarde" ?

sinon

Le 05/08/2019 à 22:26

Bonsoir,

Merci de m'aider car je galère vraiment...

Dans l'onglet "Guide" : Si la valeur d'une des cellules de la colonne B est égale à "Donnée Non Saisie" ou "Saisie Erronée" --> Copie des cellules des colonnes A-B-C dans l'onglet "Sauvegarde"

Je te mets le fichier en pièce-jointe pour que tu vois mieux.

4prepa.xlsm (98.21 Ko)
Le 05/08/2019 à 22:49

Je pense à une autre approche peut-être + simple selon la valeur de la cellule B3 :

- Si B3="ERREUR(S) DETECTEE(S)" --> Copie de :

N° Fiche /Date du contrôle /Contrôleur/Type /Num CL/Date de réception /Date de traitement / Traité par

et Copie des lignes comportant la cellule avec comme valeur "Donnée Non Saisie" ou "Saisie Erronée" (Point de contrôle/Résultat/Commentaires)

- Si B3="PAS D'ERREURS DETECTEES" --> Copie de :

N° Fiche /Date du contrôle /Contrôleur/Type /Num CL/Date de réception /Date de traitement / Traité par

et Copie de la cellule B3

Qu'en penses-tu?

4prepa.xlsm (96.13 Ko)
Le 05/08/2019 à 22:59

Slt,

à tester

Sub Archiver()
Dim sht As Worksheet
Dim lastrow As Long, ligne As Long, i As Integer
Set sht = Worksheets("Guide")

With Worksheets("Sauvegarde")
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
ligne = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & ligne).Value = sht.Range("B5").Value 'N° Fiche
.Range("B" & ligne).Value = sht.Range("D10").Value 'Date du contrôle
.Range("C" & ligne).Value = sht.Range("D9").Value 'Contrôleur
.Range("D" & ligne).Value = sht.Range("D8").Value 'Type
.Range("E" & ligne).Value = sht.Range("B6").Value 'Num CL
.Range("F" & ligne).Value = sht.Range("B7").Value 'Date de réception
.Range("G" & ligne).Value = sht.Range("B6").Value 'Date de traitement
.Range("H" & ligne).Value = sht.Range("B9").Value 'Traité par

For i = 14 To lastrow
If sht.Range("B" & i).Value = "Donnée Non Saisie" Or sht.Range("B" & i).Value = "Donnée Erronée" Then
sht.Range("A" & i & ":C" & i & "").Copy
.Range("J" & ligne).PasteSpecial
End If
Next i
End With
End Sub
Le 05/08/2019 à 23:36

Hello'

C'est déjà une très belle avancée pour moi

La copie de la cellule A14 dans l'onglet "Sauvegarde" m'affiche la formule dont elle est issue.

Comment pourrait-on corriger cela pour qu'elle affiche sa valeur?

Doi-je recopier plusieurs fois le même code que tu as fait pour que la copie se fasse également pour les autres lignes du point de contrôle

": For i = 14 To lastrow

If sht.Range("B" & i).Value = "Donnée Non Saisie" Or sht.Range("B" & i).Value = "Donnée Erronée" Then

sht.Range("A" & i & ":C" & i & "").Copy

.Range("J" & ligne).PasteSpecial"

Ou alors, peut-on simplifier le code, en sachant que les éléments du point de contrôle sont variables et dépendent du choix fait dans le menu déroulant de la cellule D8?

J'ai pensé à cette approche, qu'en dis-tu?

- Si B3="ERREUR(S) DETECTEE(S)" --> Copie de :

N° Fiche /Date du contrôle /Contrôleur/Type /Num CL/Date de réception /Date de traitement / Traité par

et Copie des lignes comportant la cellule avec comme valeur "Donnée Non Saisie" ou "Saisie Erronée" (Point de contrôle/Résultat/Commentaires)

- Si B3="PAS D'ERREURS DETECTEES" --> Copie de :

N° Fiche /Date du contrôle /Contrôleur/Type /Num CL/Date de réception /Date de traitement / Traité par

et Copie de la cellule B3

Le 06/08/2019 à 00:00

J'ai résolu le souci d'affichage de la valeur au lieu de la formule 

For i = 14 To lastrow
If sht.Range("B" & i).Value = "Donnée Non Saisie" Or sht.Range("B" & i).Value = "Donnée Erronée" Then
sht.Range("A" & i & ":C" & i & "").Copy
.Range("J" & ligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
Next i
Le 06/08/2019 à 00:02

essaie comme ca

Sub Archiver()
Dim sht As Worksheet, sht1 As Worksheet
Dim lastrow As Long, ligne As Long, i As Integer
Set sht = Worksheets("Guide")
Set sht1 = Worksheets("Sauvegarde")
ligne = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row + 1

With sht1
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For i = 14 To lastrow
If sht.Range("B" & i).Value = "Donnée Non Saisie" Or sht.Range("B" & i).Value = "Saisie Erronée" Then

.Range("A" & ligne).Value = sht.Range("B5").Value 'N° Fiche
.Range("B" & ligne).Value = sht.Range("D10").Value 'Date du contrôle
.Range("C" & ligne).Value = sht.Range("D9").Value 'Contrôleur
.Range("D" & ligne).Value = sht.Range("D8").Value 'Type
.Range("E" & ligne).Value = sht.Range("B6").Value 'Num CL
.Range("F" & ligne).Value = sht.Range("B7").Value 'Date de réception
.Range("G" & ligne).Value = sht.Range("B6").Value 'Date de traitement
.Range("H" & ligne).Value = sht.Range("B9").Value 'Traité par

sht.Range("A" & i & ":C" & i & "").Copy
.Range("J" & ligne).PasteSpecial xlPasteValues
ligne = ligne + 1
End If
Next i
End With
End Sub
Le 06/08/2019 à 00:40

Super

Je l'ai complété comme ceci :

Sub Archiver()
Dim sht As Worksheet, sht1 As Worksheet
Dim lastrow As Long, ligne As Long, i As Integer
Set sht = Worksheets("Guide")
Set sht1 = Worksheets("Sauvegarde")
ligne = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row + 1

With sht1
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For i = 14 To lastrow
If sht.Range("B" & i).Value = "Donnée Non Saisie" Or sht.Range("B" & i).Value = "Saisie Erronée" Then

.Range("A" & ligne).Value = sht.Range("D11").Value 'N° Fiche
.Range("B" & ligne).Value = sht.Range("D10").Value 'Date du contrôle
.Range("C" & ligne).Value = sht.Range("D9").Value 'Contrôleur
.Range("D" & ligne).Value = sht.Range("D8").Value 'Type
.Range("E" & ligne).Value = sht.Range("B6").Value 'Num CL
.Range("F" & ligne).Value = sht.Range("B7").Value 'Date de réception
.Range("G" & ligne).Value = sht.Range("B6").Value 'Date de traitement
.Range("H" & ligne).Value = sht.Range("B9").Value 'Traité par

sht.Range("A" & i & ":C" & i & "").Copy
.Range("J" & ligne).PasteSpecial xlPasteValues
ligne = ligne + 1
Else: sht.Range("B3").Value = "PAS D'ERREURS DETECTEES"

.Range("A" & ligne).Value = sht.Range("D11").Value 'N° Fiche
.Range("B" & ligne).Value = sht.Range("D10").Value 'Date du contrôle
.Range("C" & ligne).Value = sht.Range("D9").Value 'Contrôleur
.Range("D" & ligne).Value = sht.Range("D8").Value 'Type
.Range("E" & ligne).Value = sht.Range("B6").Value 'Num CL
.Range("F" & ligne).Value = sht.Range("B7").Value 'Date de réception
.Range("G" & ligne).Value = sht.Range("B6").Value 'Date de traitement
.Range("H" & ligne).Value = sht.Range("B9").Value 'Traité par
.Range("K" & ligne).Value = sht.Range("B3").Value
End If
Next i
End With
End Sub
Le 06/08/2019 à 00:45

excellent

bonne nuit et à la prochaine

Le 06/08/2019 à 00:55

Encore merci pour ton aide

Je viens de voir un souci :

Le résultat ne tient pas compte de tous les éléments du point de contrôle qui sont variables et dépendent du choix fait dans le menu déroulant de la cellule D8.

Par exemple, si je choisis le type 1 dans la cellule D8, j'ai 28 lignes de points de contrôle (de la cellule A14 à A41)

Si je choisis le type 2, j'en ai 8 (de la cellule A14 à A21)

3prepa.xlsm (97.54 Ko)
Le 06/08/2019 à 10:24

oui c'est normal, les colonnes Résultats et Commentaires ne contiennent pas de formnules comme la colonne Point de contrôle!

Le 06/08/2019 à 13:08

Bonjour,

En fait, je me suis mal exprimé - désolé

La copie ne se fait pas pour toutes les lignes ayant un résultat "Saisie Erronée" ou "Donnée Non saisie".

Si tu veux bien regarder, j'ai mis en évidence cela dans le fichier-joint

3prepa-2.xlsm (123.33 Ko)
Rechercher des sujets similaires à "copie conditions"