Macro d'importation sous condition

Bonsoir,

Après quelques précédents projets qui ont pu aboutir grâce à l'aide très précieuse et plus que bienvenue de Gmb, me revoilà avec un nouveau travail à produire et donc, un nouvel appel à (votre) aide !

Je dois me servir de fichiers sources (au nombre de 5) tous identiques ainsi nommés, pour l'exemple :

fichier source 1

Ces fichiers contiennent chacun 12 feuilles, pour les 12 mois de l'année (dans l'exemple je n'ai mis que deux feuilles).

De ces fichiers, je veux extraire des informations , selon des conditions, et les inscrire dans un autre fichier nommé "stats" :

J'ai mis en couleur les colonnes qui doivent être reprises dans le tableau stats. J'ajouterai cependant que les informations contenues dans ces colonnes ne sont à importer dans le tableau qu'à condition que la colonne "aide aux formalités" et / ou "Forfait Maxi ?" soit complété avec la mention "oui".

Je vous joins les tableaux ce sera plus parlant (je ne joins qu'un fichier source sachant que les 4 autres sont exactement identiques seules les informations saisies diffèrent).

A noter que je tourne maintenant sur excel 2013 au bureau.

Merci par avance de votre intérêt...!

Je reste évidemment à votre disposition pour toute explication complémentaire car je crains d'être un peu brouillonne dans mes explications.

7stats.xlsx (12.08 Ko)

Bonsoir UAP, bonsoir le forum,

Les 5 fichiers (source) se trouvent-ils tous dans le même dossier ? Le fichier stats (destination) se trouve-t-il lui aussi dans le même dossier ? Rien ne va séparer les données entre chaque mois ? Entre chaque fichier ? On empile tout les un en dessous des autres dans le tableau ? Pourquoi alors l'onglet du fichier stats se nomme 16 janvier 2017 ?

En attendant tes réponses...

Bonjour !

Tout d'abord, merci de votre intérêt pour ma problématique. Effectivement, il y a lieu d'éclaircir certains points que je n'ai pas abordé hier.

Aussi, pour répondre à vos interrogations : Les 5 fichiers sources ne seront pas dans le même dossier. Je sais cependant rechercher le chemin d'accès des fichiers pour les intégrer à une macro, je l'ai fait pour deux précédents projets , via la formule :

= CELLULE(‘’Nomfichier’’ )

(merci à Gmb du forum pour la technique)

Le fichier "Stats" sera également dans un autre dossier distinct.

Concernant la séparation des données , non il n'y aura rien entre chaque mois dans les fichiers sources. Chaque feuille correspondra à un mois. Par contre, il peut y avoir des lignes vides dans chaque feuilles sources

Par contre, dans le fichier "stats" de compilation des données, je m'en remets à vous. Qu'est-il le plus simple à réaliser ? Je m'explique :

- Soit je reproduis, dans le fichier "stats", 12 feuilles correspondants à celles des fichiers sources pour individualiser les statistiques (ça me convient)

- Soit je ne garde qu'une seule feuille dans le fichier "stats", qui reprendra l'ensemble des données des 12 feuilles sources mais, dans cette éventualité, il me faut un moyen de retrouver , dans la liste unique générée, à quelle date les réservations correspondent...

J'espère être suffisamment claire ! Le mieux étant de vous donner un exemple.

J'ai revu légèrement mes tableaux pour mettre en exemple ce que je veux obtenir.

Dans le fichier "stats", j'ai inscrit les deux possibilités, soit par feuille, soit en global..

A vous de me dire ce qui est réalisable ou non. J'espère avoir éclaircie ma demande mais, si tel n'est pas le cas, je reste à votre disposition !

Merci encore

6stats.xlsx (18.24 Ko)

Bonjour UAP, bonjour le forum,

Attention, le code proposé considère que tous les fichiers source sont ouverts. Hormis ces fichiers et le fichier stats, tous les autres classeurs Excel doivent être fermés. Comme ils ne sont pas dans le même dossier je te laisse le soin des les ouvrir et/ou de changer le début de la macro... Le code se trouve dans le fichier stats qui devient donc xlsm.

Le code :

Option Explicit 'oblige à déclarer toute les variables

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim CL As Byte 'déclare la variable CL (CLasseur)
Dim TCS() As Workbook 'déclare la variable TCS (Tableau des Classeurs Source)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim I As Byte 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim X As Long 'déclare la variable X (incrément)
Dim Y As Long 'déclare la variable Y (Incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Sheets(1) 'désinit l'onglet destination OD
'CD.Activate 'active le classeur destination
DL = OD.Range("A1").CurrentRegion.Rows.Count 'définit la dernière ligne éditée Dl de l'onglet OD
If OD.Range("A2").Value <> "" Then OD.Rows(2 & ":" & DL).Delete 'si A2 de l'onglet OD est vide, efface toutes les lignes sauf la première
For CL = 1 To Workbooks.Count 'boucle sur tous les classeurs ouverts
    'condition : si le classeur n'est pas le classeur destination ou le classeur "PERSONAL.XLSB" (ouvert chez moi mais masqué, peut-être pas chez toi)
    If Not Workbooks(CL).Name = CD.Name And Not Workbooks(CL).Name = "PERSONAL.XLSB" Then
        ReDim Preserve TCS(I) 'redimensionne le tableau des classeurs source TCS
        Set TCS(I) = Workbooks(CL) 'définit la variable indéxée TCS(I) comme étant le classeur de la boucle
        I = I + 1 'incrémente I
    End If 'fin de la condition
Next CL 'prochain classeur de la boucle ( à ce stade, TCS contient tous les classeurs source)
For I = 0 To UBound(TCS) 'boucle 1 : sur tous les classeurs source
    Set CS = TCS(I) 'définit le classeur source CS
    For J = 1 To 12 'boucle 2 : sur les 12 onglets du classeur
        Y = 1 'initialise Y
        Set OS = CS.Sheets(J) 'définit l'onglet source OS
        TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeur TV
        For X = 4 To UBound(TV, 1) 'boucle 3 : sur toutes les lignes X du tableau ds valeurs TV (en partant de la quatrième)
            'condition 1 : si "aide au formalité" ou "Forfait Maxi" en colonnes 8 et 13 de TV valent "non"
            If UCase(TV(X, 8)) = "NON" Or UCase(TV(X, 13)) = "NON" Then
                If TV(X, 4) <> "" Then 'condition 2 : si le "nom prénom" en colonne 4 n'est pas vide
                    ReDim Preserve TL(1 To 9, 1 To Y) 'redimensionne le tableau des lignes TL (9 lignes, Y colonnes)
                    TL(1, Y) = TV(X, 4) 'récupère en ligne 1 de TL, la données colonne 4 de TV "nom prénom" (= Tranposition)
                    TL(2, Y) = TV(X, 5) 'récupère en ligne 2 de TL, la données colonne 5 de TV "type de réservation" (= Tranposition)
                    TL(3, Y) = TV(X, 8) 'récupère en ligne 3 de TL, la données colonne 8 de TV "aide aux formalités" (= Tranposition)
                    TL(4, Y) = TV(X, 9) 'récupère en ligne 4 de TL, la données colonne 9 de TV "nb assuré pour..." (= Tranposition)
                    TL(5, Y) = TV(X, 10) 'récupère en ligne 5 de TL, la données colonne 10 de TV "montant du forfait" (= Tranposition)
                    TL(6, Y) = TV(X, 13) 'récupère en ligne 6 de TL, la données colonne 13 de TV "forfait maxi" (= Tranposition)
                    TL(7, Y) = TV(X, 14) 'récupère en ligne 7 de TL, la données colonne 14 de TV "type de forfait" (= Tranposition)
                    TL(8, Y) = CS.Name 'récupère en ligne 8 de TL le nom du fichier source
                    TL(9, Y) = OS.Name 'récupère en ligne 9 de TL le nom de l'onglet source (la date)
                    Y = Y + 1 'incrémente Y (ajoute une colonne au tableau des lignes TL)
                End If 'fin de la condition 2
            End If 'fin de la condition 1
        Next X 'prichaine ligne 3
        If Y > 1 Then 'condition : si Y est supérieure à 1
            Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
            DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
            Erase TL 'vide le tableau TL
        End If 'fin de la condition
    Next J 'prochain onglet de la boucle 2
Next I 'prochain classeur de la boucle 1
End Sub

Teste et dis-moi...

Le fichier :

8stats.xlsm (21.98 Ko)

Bonjour,

Merci beaucoup pour ton travail et ton implication.

Toutefois, j'ai un souci par rapport aux détails que tu as indiqué. C'est à dire qu'en préambule, tu m'as précisé qu'il fallait que seuls les fichiers sources excel soient ouverts lors de l'utilisation de la macro et que tous les autres devaient être fermés.

Le problème c'est que nous sommes 5 agents à travailler avec les fichiers sources mais des milliers d'autres à utiliser des fichiers excel potentiellement en même temps sur des serveurs similaires !

Ce n'est donc pas viable pour mon projet. Je vais regarder de plus près ta formule et voir si elle est transposable par rapport à d'autres macro que j'utilise sur d'autres types de fichiers statistiques.

Merci encore !

Bonjour,

Je reviens vers vous car je bloque sur un problème (et je n'en suis qu'au début...!). Voilà, comme expliqué dans mon dernier post, je ne peux pas utiliser la formule de ThauTheme tel quel car je n'ai pas possibilité de savoir si les seuls fichiers excel ouverts seront ceux demandés par ma macro.

j'ai donc décidé de m'orienter vers une autre solution mais mes capacités limités en VBA ne me permettent pas d'avancer seule.

J'ai opté pour une macro intégrant les chemins de mes fichiers pour n'ouvrir et récupérer les données que des fichiers sources concernés. Pour ne pas être non plus embêtée avec de multiples conditions quant aux colonnes à récupérer, j'ai légèrement modifié mon fichier "stats" en mettant un tableau identique à mes fichiers sources mais en masquant simplement les colonnes que je n'ai pas besoin d'étudier (je suis la McGyver de la VBA, je contourne le problème avec les moyens du bord).

Cependant, si ma macro tourne, j'ai un problème lors de la récupération des données. En effet, j'ai mis pour l'heure deux fichiers sources en test, mais, lorsque la macro s'execute, je vois bien les deux fichiers sources s'ouvrir mais seules les données du fichiers source 2 s'affichent dans mon tableau stats. Les données du fichiers source 2 semblent écraser les données sources 1 au lieu de s'implanter à la suite sur des lignes supplémentaires..

Pourriez-vous m'indiquer ce qui cloche dans ma macro ? En outre, dans le corps de ma macro, j'ai certains termes qui devraient être en bleu et qui ne le sont pas...pourquoi ?

Je vous joins mes fichiers pour mieux comprendre car je sais que je suis très brouillonne dans mes explications et je m'en excuse platement !

Une fois que j'aurai solutionné ce problème , il me faudra encore m'attaquer aux données conditionnelles (ne reprendre les lignes complétées que si et seulement si la mention "oui" apparaît dans les colonnes H et/ou M..

Merci d'avance à tous pour votre aide.

Edit de 19h48 pour ajouter le code ici même :

Option Explicit

Dim wb, chemin, nomFichier, classeur, derLn, lgn, i

Dim dossierA, dossierB, dossier

Sub Importations()

'on initialise les zones de réception des données

Set wb = ActiveWorkbook

With wb

.Sheets(Feuil1.Name).Range("A2").CurrentRegion.Offset(1, 0).ClearContents

.Sheets(Feuil2.Name).Range("A2").CurrentRegion.Offset(1, 0).ClearContents

dossierA = "C:\Users\Asus\Desktop\Pour macro\Fichier Source 1"

dossierB = "C:\Users\Asus\Desktop\Pour macro\Fichier Source 2"

dossier = Array(dossierA, dossierB)

'on ouvre les fichiers et on récupère leurs données

For i = 0 To 1

nomFichier = dossier(i)

If nomFichier <> ThisWorkbook.Name Then

Set classeur = Workbooks.Open(chemin & nomFichier)

Sheets("16 janvier 2017").Activate

lgn = .Sheets(Feuil1.Name).Range("A" & Rows.Count).End(xlUp)(2).Row

Sheets("16 janvier 2017").Range("D2:Q" & Range("D" & Rows.Count).End(xlUp).Row).Copy .Sheets(Feuil1.Name).Range("D" & lgn)

lgn = .Sheets(Feuil2.Name).Range("A" & Rows.Count).End(xlUp)(2).Row

Sheets("19 février 2017").Range("D2:Q" & Range("D" & Rows.Count).End(xlUp).Row).Copy .Sheets(Feuil2.Name).Range("D" & lgn)

classeur.Close

End If

Next i

End With

End Sub

5stats.xlsm (31.00 Ko)

Bonsoir le forum,

Je pense avoir trouvé le problème. Il ne s'agissait pas véritablement d'un problème dans mon code qui s'opérait correctement.

Le problème venait d'une erreur de ma part. Dans mes fichiers sources, j'avais tout simplement laissé des colonnes vides. De fait, le report dans le tableau récapitulatif "stats" se faisait de manière incorrect.

Du coup j'ai revu mon code pour intégrer l'ensemble des colonnes en report et j'ai complété l'ensemble des colonnes de mes fichiers sources.

Option Explicit

Dim wb, chemin, nomFichier, classeur, derLn, lgn, i
Dim dossierA, dossierB, dossier

Sub Importations()

    'on initialise les zones de réception des données
   Set wb = ActiveWorkbook
    With wb
        .Sheets(Feuil1.Name).Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        .Sheets(Feuil2.Name).Range("A1").CurrentRegion.Offset(1, 0).ClearContents

        dossierA = "C:\Users\Asus\Desktop\Pour macro\Fichier Source 1"
        dossierB = "C:\Users\Asus\Desktop\Pour macro\Fichier Source 2"
        dossier = Array(dossierA, dossierB)

        'on ouvre les fichiers et on récupère leurs données
       For i = 0 To 1
            nomFichier = dossier(i)
            If nomFichier <> ThisWorkbook.Name Then
                Set classeur = Workbooks.Open(chemin & nomFichier)
                Sheets("16 janvier 2017").Activate
                lgn = .Sheets(Feuil1.Name).Range("A" & Rows.Count).End(xlUp)(2).Row
                Sheets("16 janvier 2017").Range("A2:S" & Range("A" & Rows.Count).End(xlUp).Row).Copy .Sheets(Feuil1.Name).Range("A" & lgn)
                lgn = .Sheets(Feuil2.Name).Range("A" & Rows.Count).End(xlUp)(2).Row
                Sheets("19 février 2017").Range("A2:S" & Range("A" & Rows.Count).End(xlUp).Row).Copy .Sheets(Feuil2.Name).Range("A" & lgn)
                classeur.Close
            End If
        Next i
    End With
End Sub

Selon vous, comment puis-je faire pour qu'une ligne et/ou colonne vide ne provoque pas de souci dans ma macro ?

En attendant de résoudre ce point de détail, je vais plancher sur la notion de condition...!

J'ai cru comprendre qu'il fallait utiliser : If suivi de Then et End If

Merci d'avance à quiconque sera en mesure de m'aider.

Voilà, après des heures de recherches, de tests, de modifications, je suis parvenue au résultat voulu.

La solution n'est pas optimale et, pour la plupart des personnes s'y connaissant en VBA, ma méthode risque de leur paraître ridicule et grandement perfectible mais j'ai fait avec les moyens du bord et mes connaissances plus que limitées en la matière.

Donc, ma macro de base qui sert à récupérer les données des différents fichiers sources :

Sub Importations()

    'on initialise les zones de réception des données
   Set wb = ActiveWorkbook
    With wb
        .Sheets(Feuil1.Name).Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        .Sheets(Feuil2.Name).Range("A1").CurrentRegion.Offset(1, 0).ClearContents

        dossierA = "C:\Users\Asus\Desktop\Pour macro\Fichier Source 1"
        dossierB = "C:\Users\Asus\Desktop\Pour macro\Fichier Source 2"
        dossier = Array(dossierA, dossierB)

        'on ouvre les fichiers et on récupère leurs données
       For I = 0 To 1
            nomFichier = dossier(I)
            If nomFichier <> ThisWorkbook.Name Then
                Set classeur = Workbooks.Open(chemin & nomFichier)
                Sheets("16 janvier 2017").Activate
                lgn = .Sheets(Feuil1.Name).Range("A" & Rows.Count).End(xlUp)(2).Row
                Sheets("16 janvier 2017").Range("A2:S" & Range("A" & Rows.Count).End(xlUp).Row).Copy .Sheets(Feuil1.Name).Range("A" & lgn)
                lgn = .Sheets(Feuil2.Name).Range("A" & Rows.Count).End(xlUp)(2).Row
                Sheets("19 février 2017").Range("A2:S" & Range("A" & Rows.Count).End(xlUp).Row).Copy .Sheets(Feuil2.Name).Range("A" & lgn)
                classeur.Close
            End If
        Next I
    End With
End Sub

Après avoir récupéré l'ensemble des données des différents fichiers, feuilles par feuilles et lignes par lignes, je devais encore me débarrasser des lignes vides et, souhaitant ne récupérer que des données sous conditions (mention "Oui" dans la colonne H et/ou M),.

Dans un premier temps, j'ai trouvé une macro pour supprimer les lignes vides puis une troisième pour les conditions mais, l'ensemble successif provoquait une erreur...

Il me fallait trouver un moyen subsidiaire d'y parvenir. J'ai donc fait tenir, en une seule macro, la suppression des lignes et colonnes conditionnelles, à exécuter après la macro d'importations :

   Sub supprimerlv()
      Dim I As Integer
        dl = Cells.SpecialCells(xlLastCell).Row
        For I = dl To 1 Step -1
         If Cells(I, 1) = "" And Cells(I, 2) = "" And Cells(I, 3) = "" And Cells(I, 4) = "" Then
          Rows(I).Delete
         End If
        Next I
For I = 300 To 2 Step -1
    If (Cells(I, 8).Value Like "Non" And Cells(I, 13).Value Like "Non") Then
        Rows(I).Delete
    End If
Next
    End Sub

D'après les premiers tests réalisés, cela semble fonctionner. Il me faut bien sûr poursuivre mes tests avec davantage de données pour être sûre que cela fonctionne correctement mais, pour un premier jet, je suis assez fière de moi.

Pour l'heure, je vais mettre ce sujet comme résolu...Cependant, si une âme charitable voyait un moyen plus simple de perfectionner ces deux macros, je suis preneuse !

merci d'avance et , par ce post, je tenais surtout à remercier Thauthème pour son investissement et pardon de n'avoir pas su être plus claire dans mes explications initiales

9stats.xlsm (28.39 Ko)
Rechercher des sujets similaires à "macro importation condition"