Extraction de données d'un fichier vers un autre
Bonjour le forum,
A ce jour je suis bloqué pour finir de rédiger la macro. Voici en détail comment devrait fonctionner cette macro.
J'ai deux fichiers (plan d'action SMQ, Tableau suivi des actions). Dans le tableau suivi des actions, j'ai inséré un bouton qui ira vérifier dans le fichier plan d’action SMQ, si une date est saisie dans la colonne W et cela dès la ligne 10 (W10).
Le fichier Plan d’action SMQ est toujours enregistré sous le chemin d'accès : G:\S-ISO. Voici le code :
Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select 'Feuil1(nom de gauche en projet)
Chemin = "G:\S - ISO\"
Fichier = TextBox1.Text & ".xls"
On Error Resume Next
Set Wb = GetObject(Chemin & Fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
Dans le « Plan d’action SMQ », si la cellule W10 est vide et en U10 (contenant une date) < à aujourd’hui alors la macro devra coller les données issues du Plan d’action SMQ vers le « Tableau suivi des actions » comme indiqué ci-dessous. Si aucune date est saisie en U10 alors opération terminée.
Si une date est saisie en W10 alors on ira plutôt vérifier la cellule en AD10 (contenant une date). Si AD10 est vide et en AA10 (contenant une date) < à aujourd’hui alors la macro devra coller les données issues du Plan d’action SMQ dans le « Tableau suivi des actions » comme ci-après :
Valeurs issues du Plan d’action SMQ vers Tableau suivi des actions
Colonne T -----------------------------------------------> Colonne D
Colonne A -----------------------------------------------> Colonne F
Colonne G -----------------------------------------------> Colonne G
Colonne P -----------------------------------------------> Colonne H
Colonne M -----------------------------------------------> Colonne I
Colonne H -----------------------------------------------> Colonne J
Colonne O -----------------------------------------------> Colonne J
La macro vérifiera toujours depuis la ligne 10 du Plan d’action SMQ jusqu’à la dernière ligne où une date est saisie en U10. Si U10 vide l’analyse est terminée.
-- 10 Nov 2010, 12:16 --
J'ai ce code complet mais je pense qu'il possède des erreurs pour répondre à mon problème. La rédaction est elle en partie bonne ?
Private Sub CommandButton1_Click()
Dim Wb As Workbook
Feuil1.Select 'Feuil1(nom de gauche en projet)
Chemin = "G:\S - ISO\"
Fichier = TextBox1.Text & ".xls"
On Error Resume Next
Set Wb = GetObject(Chemin & Fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
Workbooks.Open (fichierAOuvrir)
Set Wb = ActiveWorkbook
Windows(WbPrincipal.Name).Activate
With Wb.Sheets("Feuil1")
For k = 10 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
lig = [I65536].End(3).Row + 1
If Range("W10").Value = "" Then
If Range("U10").Value < aujourdhui() Then GoTo extract
End If
End If
If Range("AD10").Value = "" Then
If Range("AA10").Value < aujourdhui() Then GoTo extract
End If
End If
Exit Sub
extract:
Range("D" & lig).Value = .Range("T" & k).Value
Range("F" & lig).Value = .Range("A" & k).Value
Range("G" & lig).Value = .Range("G" & k).Value
Range("H" & lig).Value = .Range("P" & k).Value
Range("I" & lig).Value = .Range("M" & k).Value
Range("J" & lig).Value = .Range("H" & k).Value
Range("J" & lig).Value = .Range("O" & k).Value
End If
Next
-- 10 Nov 2010, 15:30 --
Voilà la macro plante au niveau du mot "aujourdhui" dans la ligne suivante ;
If Range("U10").Value < aujourdhui() Then GoTo extract
Bonjour,
Essayez de changer
If Range("U10").Value < aujourdhui() Then GoTo extract
par
If Range("U10").Value < Now Then GoTo extract
Cordialement.
PMO
Patrick Morange
Bonjour et merci PMO pour ta réponse mais voici le code complet et fonctionnant
Private Sub CommandButton1_Click()
Dim Wb1 As Workbook, wb2 As Workbook, Chemin As String, Fichier As String
Dim wb As Workbook
Application.ScreenUpdating = False
'j'initialize le premier classeur ici: tableau suivi action en retard
Set Wb1 = ThisWorkbook
'j'indique le chemin et le nom du deuxième classeur
Chemin = "G:\S - ISO\"
Fichier = Chemin & TextBox1.Text & ".xls"
On Error Resume Next
'je vérifie si le classeur est présent
Set wb = GetObject(Fichier)
If Err <> 0 Then MsgBox "Fichier Absent": Exit Sub
'j'ouvre le classeur: plan d'actions SMQ
Workbooks.Open Fichier
'j'initialize le deuxieme classeur
Set wb2 = ActiveWorkbook
lig = Wb1.Sheets("Feuil1").[D65536].End(3).Row + 1
With wb2.Sheets("Feuil1")
For k = 10 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
'si les conditions sont remplies alors je vais à extract
If Range("W10").Value = "" And Range("U10").Value < Date Then GoTo extract
If Range("AD10").Value = "" And Range("AA10").Value < Date Then GoTo extract
If Range("U10").Value = "" Then GoTo extract
Exit Sub
extract:
Wb1.Sheets("Feuil1").Range("D" & lig).Value = .Range("T" & k).Value
Wb1.Sheets("Feuil1").Range("F" & lig).Value = .Range("A" & k).Value
Wb1.Sheets("Feuil1").Range("G" & lig).Value = .Range("G" & k).Value
Wb1.Sheets("Feuil1").Range("H" & lig).Value = .Range("P" & k).Value
Wb1.Sheets("Feuil1").Range("I" & lig).Value = .Range("M" & k).Value
Wb1.Sheets("Feuil1").Range("J" & lig).Value = .Range("H" & k).Value
Wb1.Sheets("Feuil1").Range("K" & lig).Value = .Range("O" & k).Value
lig = lig + 1
End If
Next k
End With
'je referme le classeur plan d'action sans sauvegarder
wb2.Close
'j'active le classeur tableau suivi
Wb1.Sheets("Feuil1").Activate
Application.ScreenUpdating = True
'je referme l'userform
Unload UserForm1
End Sub
J'aimerai rajouter des conditions mais cela plante au niveau des "Or". Je continue à chercher et merci pour votre aide.
If Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" or "Audit blanc IFS" or "Audit blanc BRC" or "Audit interne ISO" or "Audit interne IFS" or "Audit interne BRC" or "Audit Certif ISO" or "Audit Certif IFS" or "Audit Certif BRC" And Range ("AD10").Value = "" And Range ("AA10").Value < Date Then GoTo extract
If Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" or "Audit blanc IFS" or "Audit blanc BRC" or "Audit interne ISO" or "Audit interne IFS" or "Audit interne BRC" or "Audit Certif ISO" or "Audit Certif IFS" or "Audit Certif BRC" And Range ("AA10").Value = "" Then GoTo extract
If Range("U10").Value = "" Then GoTo extract
-- 15 Nov 2010, 16:29 --
Voici le code que j'ai trouvé
If Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" Or Range("M10").Value = "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AD10").Value = "" And Range("AA10").Value < Date Then GoTo extract
If Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" Or Range("M10").Value = "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AA10").Value = "" Then GoTo extract
Malheureusement ces conditions ne sont pas remplies
Les cellules des colonnes U, W, AA, et AD dès la ligne 10 contiennent qu'une date
La cellule M dès la ligne 10 contient que du texte
Voci les conditions :
1) si il n'y a pas de date en U10 on recopie la ligne conformément à l'extraction
2) si il y a une date en U10 et que celle-ci est < à aujourd'hui et qu'en W10 il n'y a pas de date, on recopie la ligne conformément à l'extraction. (si U10 la date est > à aujourd'hui et qu'en W10 il n'y a pas de date, on passe à l'analyse de la ligne suivante sans recopier)
3) si il y a une date en U10 et que celle-ci < à aujourd'hui et qu'en W10 la date est saisie (peu importe si elle est < ou pas à aujourd'hui), on vérifie si M10 = audit blanc ISO,... et si le contenu correspond on vérifie si il y a une date en AA10, si ce n'est pas le cas, on recopie la ligne conformément à l'extraction
4) si il y a une date en U10 et que celle-ci < à aujourd'hui et qu'en W10 la date est saisie (peu importe si elle est < ou pas à aujourd'hui), on vérifie si M10 = audit blanc ISO,... et si le contenu correspond on vérifie si il y a une date en AA10, si c'est le cas on vérifie si elle est < à aujourd'hui, si c'est le cas, on vérifie si en AD10 une date est saisie, si c'est pas le cas on recopie la ligne conformément à l'extraction. (si AD10 est complétée on passe à l'analyse de la ligne suivante sans recopier)
5) si il y a une date en U10 et que celle-ci < à aujourd'hui et qu'en W10 la date est saisie (peu importe si elle est < ou pas à aujourd'hui), on vérifie si M10 = audit blanc ISO,... et si le contenu correspond on vérifie si il y a une date en AA10, si c'est le cas on vérifie si elle est < à aujourd'hui, si c'e n'est pas le cas, on passe à l'analyse de la ligne suivante sans recopier.
Bonjour,
Voici un extrait du code concernant l'extraction de données avec plusieurs conditions et qui ne fonctionne pas car :
- il me copie trois fois les mêmes données alors qu'une fois suffirait donc j'ai mis des Else mais il me marque comme message d'erreur :
Erreur de compilation : Erreur de syntaxe
- apparemment les and et or lui pose des problèmes également car ces conditions ne sont pas prises en comptes
Si vous avez une idée pour résoudre ce problème ? Précision : je suis sur le pc du travail et malheureusement les fichiers d'aide ne sont pas disponsibles.
Extrait du code :
If Range("W10").Value = "" And Range("U10").Value < Date Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
Else If Range("U10").Value = "" Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
Else If Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" Or Range("M10").Value = "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AD10").Value = "" And Range("AA10").Value < Date Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
Else If Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" Or Range("M10").Value = "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AA10").Value = "" Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
End If
Bonjour,
Ecrire ElseIf au lieu de Else If
Cordialement.
PMO
Patrick Morange
Bonjour PMO,
Ok j'ai remplacé et celà ne plante pas. Par contre il ne tiend pas compte des conditions.
Exemple : si U10 > Date et W10 = "" il m'affiche les données alors que la date est supèrieure à aujourd'hui.
Je sais plus comment m'y prendre pour rédiger correctement ces conditions, si quelqu'un pouvez m'aider. D'avance merci.
Voici le code avec les ElseIf
With Wb2.Sheets("Feuil1")
For k = 10 To .[A65536].End(3).Row
If .Range("A" & k) <> "" Then
'si les conditions sont remplies alors je vais à extract
If Range("W10").Value = "" And Range("U10").Value < Date Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
ElseIf Range("U10").Value = "" Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
ElseIf Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" Or Range("M10").Value = "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AD10").Value = "" And Range("AA10").Value < Date Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
ElseIf Range("W10").Value <> "" And Range("M10").Value = "Audit blanc ISO" Or Range("M10").Value = "Audit blanc IFS" Or Range("M10").Value = "Audit blanc BRC" Or Range("M10").Value = "Audit interne ISO" Or Range("M10").Value = "Audit interne IFS" Or Range("M10").Value = "Audit interne BRC" Or Range("M10").Value = "Audit Certif ISO" Or Range("M10").Value = "Audit Certif IFS" Or Range("M10").Value = "Audit Certif BRC" And Range("AA10").Value = "" Then
'Appel de la fonction extract
Extr = extract(Lig, k)
Lig = Lig + 1
End If
'Je pense que c'est ton Exit sub qui doit géner...
'Exit Sub ' Si aucune condition vraie... alors quitter la macro
End If
Next k
End With