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

[thomasdu40]

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).

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.

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

 

[thomasdu40]

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

La macro plante au niveau du mot "aujourdhui" dans la ligne

If Range("U10").Value < aujourdhui() Then GoTo extract

 

[Cousinhub]

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

Bonjour,

Si n'y a que cela, remplace "aujourdhui()" par "Date" (sans les guillemets)

Bonne journée

 

[thomasdu40]

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

Oui c'est fait et merci à toi.

J'ai retravaillé le code et voici comment il est maintenant mais l'erreur qu'il m'indique est la suivante :

Erreur de compilation : Bloc If sans End If

Mon code complet est :

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 = "" And Range("U10").Value < Date Then GoTo extract
            If Range("AD10").Value = "" Then
                If Range("AA10").Value < Date Then GoTo extract
                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 Sub

 

[thomasdu40]

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

Bonjour le forum,

Pour continuer sur ce post j'aimerai rajouter des conditions mais celles-ci ne fonctionnent pas

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

Voici le rappel du contenu des cellules et des conditions :
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.

 

[thomasdu40]

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

Bonjour le forum,

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