Extraction de données d'un fichier vers un autre

Le 10/11/2010 à 09:22

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
143tableau-suivi-actions-en-retards.zip (9.90 Ko)
140plan-d-action-smq.xls (16.00 Ko)
Le 12/11/2010 à 15:31

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

Le 15/11/2010 à 11:55

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.

Le 22/11/2010 à 11:46

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
Le 22/11/2010 à 13:46

Bonjour,

Ecrire ElseIf au lieu de Else If

Cordialement.

PMO

Patrick Morange

Le 22/11/2010 à 14:37

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
Rechercher des sujets similaires à "extraction donnees fichier"