Extraction et macro, possible ?

[Julie-F]

Bonjour à tous

J'ai un grand besoin d'aide. Je dois extraire les données d'un classeur sur lequel je ne peux agir qui contient plus de 120 onglets dans un nouveau fichier.
Mais plusieurs obstacles.
Seulement 100 onglets, tous batis de la même manière, sont concernés par cette récupération.
Dans Visual Objet, les onglets ne se suivent pas.

Dans ces conditions, est il possible de réaliser une macro qui puisse automatiser le
tout ?
J'ai essayé mais je n'y arrive pas et tourne en boucle mes connaissances étant limitées.

Merci d'avance.

 

[JNP]

Re : Extraction et macro, possible ?

Bonjour Julie-F ,
Si ta condition est bien que le nom de l'onglet est inférieur à 3 caractères :

Dim Feuille As Worksheet
For Each Feuille In Worksheets
If Len(Feuille.Name) < 3 Then
' Ta récupération
End If
End With

Bon WE

 

[Julie-F]

Re : Extraction et macro, possible ?

Bonjour JNP

Merci beaucoup pour ta réponse.
J'ignore si tu as regardé le fichier joint mais c'est fait de bric et de broc ce qui fait que l'extraction de données ne s'exécute pas même sans prendre en compte la condition sur les onglets.

Bon we à toi

 

[gillesdemev]

Re : Extraction et macro, possible ?

bonjout Julie , JNP et tous
un long silence involontaire de ma part (santé)
voici un exemple que j'ai utilisé pour récupérer tout et n'importe quoi dans un fichier qui contenanit une feuille par carton de déménagement
ce n'est sans doute pas génial mais vous me pardonnerez certainement

Amitié à tout et bon WE

 

[JNP]

Re : Extraction et macro, possible ?

Re ,

J'ignore si tu as regardé le fichier joint mais c'est fait de bric et de broc ce qui fait que l'extraction de données ne s'exécute pas même sans prendre en compte la condition sur les onglets.

J'ai regardé, mais j'avoue qu'il y avait un peu trop de code un peu partout, j'ai juste corrigé ce qui paraissait ton problème ...
Après, tu peux récupérer tes valeurs avec Feuille.Range("A1") ou Feuille.Cells(1, 1) par exemple ...
Bon courage

 

[Julie-F]

Re : Extraction et macro, possible ?

C'est vrai que ce n'est pas çà.

JNP, sans vouloir abuser de ton temps, je joins mon fichier récup à un fichier test (classeur à récupérer).
Peux tu m'indiquer les étapes à effectuer afin d'obtenir l'extraction des informations chiffrées souhaitées ?
J'ai limité les cellules à récupérer.

Merci encore.

 

[JNP]

Re : Extraction et macro, possible ?

Re ,
Quelque chose comme ça

Sub Test()
Dim Feuille As Worksheet, I As Integer
I = 2
For Each Feuille In Workbooks("Classeur à récup.xls").Worksheets
If Len(Feuille.Name) < 3 Then
With ThisWorkbook.Sheets("Feuil1")
.Range("D" & I) = Feuille.Range("D2")
' etc.
I = I + 1
End With
End If
Next
End Sub

en ayant les 2 classeurs ouverts.
L'association d'un Array et d'une sous boucle pourrait éviter d'avoir plein de ligne avec l'échange des Range, mais c'est déjà un premier pas ...
Si tu veux ouvrir le classeur avant, il y a plein d'exemple sur le forum ...
Bon courage

 

[KenDev]

Re : Extraction et macro, possible ?

Bonjour Julie, Gilles, JNP

Avec le dernier classeur j'ai cru comprendre que la longueur du nom des feuilles n'était pas un critère ? Ci joint un essai à lancer depuis la feuille receveuse, le classeur recevant les données ne doit pas être dans le dossier contenant les classeurs à explorer. Le test pour savoir si une feuille doit être considérée ou pas se fait simplement sur le fait que les cellules A4, K2 etc sont vides. Ce test demanderait sûrement à être affiné avec des informations supplémentaires (toutes les cellules à importées sont forcément non vide ? Au moins l'une d'elle doit être forcément non vide et contenir un type de donnée particulier ?..). A voir. Cordialement

KD

Option Explicit
'référence Microsoft Scripting Runtime activée
'menu VBE outils - références
Const DossierFichiers As String = "C:\test macro\"
Const TypeFichier As String = "xls"
Sub RecupJ()
Dim fso As FileSystemObject, fs2 As Object, Fic As Object
Dim oWb1 As Workbook, oWb2 As Workbook, oWs1 As Worksheet, oWs2 As Worksheet
Dim i%, Rw As Long, Cr(4 To 27) As String, j%, c%, Ong$
Set fso = CreateObject("Scripting.FileSystemObject")
Set fs2 = CreateObject("Scripting.FileSystemObject").GetFolder(DossierFichiers)
Set oWb1 = ThisWorkbook: Set oWs1 = ActiveSheet
Rw = oWs1.Cells(Rows.Count, 1).End(xlUp).Row
For i = LBound(Cr) To UBound(Cr)
    Cr(i) = oWs1.Cells(1, i)
Next i
For Each Fic In fs2.Files
    If LCase(Right(Fic.Name, 3)) = TypeFichier Then
        Workbooks.Open (DossierFichiers & "\" & Fic.Name)
        Set oWb2 = Workbooks(Fic.Name)
        For i = 1 To oWb2.Worksheets.Count
            Rw = Rw + 1
            c = 0
            oWs1.Cells(Rw, 1) = oWb2.Name
            oWs1.Cells(Rw, 2) = DossierFichiers
            oWs1.Cells(Rw, 3) = oWb2.Worksheets(i).Name
            For j = LBound(Cr) To UBound(Cr)
                oWs1.Cells(Rw, j) = oWb2.Worksheets(i).Range(Cr(j))
                If oWb2.Worksheets(i).Range(Cr(j)) <> "" Then c = c + 1
            Next j
            If c = 0 Then
                oWs1.Rows(Rw).Delete
                Rw = Rw - 1
            End If
        Next i
        Workbooks(Fic.Name).Close
    End If
Next
End Sub

 

[Julie-F]

Re : Extraction et macro, possible ?

Bonjour Gilles, JNP, KenDev

Kendev, c'est absolument incroyable ce que tu réussis à faire.
C'est dans cette direction que je voudrais aller mais les macro sont pour moi aussi naturelles que pourrait l'être le chinois pourtant je ne demande qu'à apprendre.

Par exemple : la macro bloque (Message Incompatibilité de type" sur l'onglet "Ensemble" du fichier dont on doit récupérer les données, ici
If oWb2.Worksheets(i).Range(Cr(j)) <> "" Then c = c + 1

Il n'y a pas de règle quant aux données à récupérer (les cellules peuvent être vides ou pas). Unique obligation prendre en compte l'ensemble des onglets dont le nom comporte au maximum 3 lettres.
La plupart de informations recueillies sont des heures (format h:mm) résultant déjà de calculs pour le reste des chiffres entiers.

N'y connaissant pas grand chose, j'ai une multitude de questions.

Est il possible de lui indiquer quelles seront les cellules = chiffres entiers et c elles pour lesquelles il faudra appliquer une conversion de chiffres pour obtenir des heures /mn ?

Peut-on choisir le fichier dont on souhaite récupérer les infomations plutôt qu'effectuer une extraction de l'ensemble des fichiers se trouvant dans un répertoire ?

La macro fait référence à l'entête des colonnes du fichier Récup., à quel endroit peut-on indiquer des entêtes plus explicites ?

 

[KenDev]

Re : Extraction et macro, possible ?

Bonjour à tous,

Je n'ai pas réussi à reproduire l'erreur 'Incompatibilité de type' pourrait tu :
_repérer la valeur de j au moment de l'erreur
_voir à quelle cellule cela correspond (j=1->A4, j=2->K2 etc..) et t'intéresser au contenu de la cellule
ou transmette un classeur ne contenant que cet onglet ?

Ceci dit je remet la condition 'onglets dont le nom comporte au maximum 3 lettres'.

Oui il est possible d'indiquer si la valeur de la cellule importée doit être entière et faire une conversion (la durée entière est exprimée en minutes ?)

On peut également choisir le fichier.

Je ne suis pas sur de comprendre la dernière question, d'autant plus que l'en-tête des colonnes actuelles m'arrangeait bien !

Dans le classeur ci-joint j'ai laissé le 1er code dans le module 2 (juste ajouté la condition maximum 3 lettres). Sub RecupJ2 à lancer depuis Feuil2.

J'ai rajouté un code à lancer depuis la feuille 1 (Sub RecupJ1). Les en têtes de colonnes sont libres (c'est comme ça que j'ai traduit ta dernière question). On choisit le classeur à ouvrir (la référence sripting devient inutile). Certaines cases sont définies en tant que valeur à convertir en heures/minutes (je suis parti du principe que la durée entière est exprimée en minutes ?). Dans l'exemple du code les cellules concernées sont A6, C11, K22, K28. (On pourrait aussi faire un test sur les cellules si il peut y avoir des exceptions et/ou prédéfinir toutes les case)

Cordialement

KD

Option Explicit

Sub RecupJ1()
Dim oWb1 As Workbook, oWb2 As Workbook, oWs1 As Worksheet, oWs2 As Worksheet
Dim i%, Rw As Long, Cr$(4 To 27), j%, c%, Ong$, Fich, Dos$, Ent%(4 To 27)
'initialisation classeur et feuille receveuse
Set oWb1 = ThisWorkbook: Set oWs1 = ActiveSheet
'dernière ligne écrite
Rw = oWs1.Cells(Rows.Count, 1).End(xlUp).Row
'tableau adresse des cellules
Cr(4) = "A4": Cr(5) = "K2": Cr(6) = "A6": Cr(7) = "C7": Cr(8) = "C298": Cr(9) = "C303"
Cr(10) = "D311": Cr(11) = "C312": Cr(12) = "D314": Cr(13) = "C315": Cr(14) = "C11": Cr(15) = "D53"
Cr(16) = "C123": Cr(17) = "D177": Cr(18) = "C209": Cr(19) = "D253": Cr(20) = "C268": Cr(21) = "C324"
Cr(22) = "D325": Cr(23) = "C326": Cr(24) = "K22": Cr(25) = "K26": Cr(26) = "K28": Cr(27) = "K16"
'tableau type cellules à récupérer (1-> valeur à convertir en heure/minutes)
Ent(6) = 1: Ent(14) = 1: Ent(24) = 1: Ent(26) = 1
'ouvrir un classeur
Fich = Application.GetOpenFilename("(*.xls), *.xls")
'quitter si click annuler
If Fich = False Then Exit Sub
'initialisation classeur source
Set oWb2 = Workbooks.Open(Fich)
'pour chaque caractère du nom long du fichier 
For i = 1 To Len(Fich)
    'au 1er "\" rencontré à droite
    If Left(Right(Fich, i), 1) = "\" Then
        'récupère nom du dossier et quitte la boucle
        Dos = Left(Fich, Len(Fich) - i)
        Exit For
    End If
Next i
'pour chaque feuille
For i = 1 To oWb2.Worksheets.Count
    'si son nom comporte 3 caractères au plus
    If Len(oWb2.Worksheets(i).Name) < 4 Then
        'ajuster ligne d'écriture et compteur de cellules récupérées pour la feuille en cours
        Rw = Rw + 1: c = 0
        'écritures colonnes 1 à 3
        oWs1.Cells(Rw, 1) = oWb2.Name
        oWs1.Cells(Rw, 2) = Dos
        oWs1.Cells(Rw, 3) = oWb2.Worksheets(i).Name
        'pour chaque élément du tableau adresse
        For j = LBound(Cr) To UBound(Cr)
            'écriture de la cellule correspondante si non vide et ajustement compteur
            If oWb2.Worksheets(i).Range(Cr(j)) <> "" Then
                c = c + 1
                'si valeur à convertir
                If Ent(j) = 1 Then
                    'format
                    oWs1.Cells(Rw, j).NumberFormat = "[h]:mm:ss"
                    'valeur lue est en minutes
                    oWs1.Cells(Rw, j) = oWb2.Worksheets(i).Range(Cr(j)) / 1440
                Else
                    oWs1.Cells(Rw, j) = oWb2.Worksheets(i).Range(Cr(j))
                End If
            End If
        Next j
        'si rien n'a été récupéré pour cette feuille suppression de la ligne et ajustement ligne d'écriture
        If c = 0 Then
            oWs1.Rows(Rw).Delete: Rw = Rw - 1
        End If
    End If
Next i
Workbooks(oWb2.Name).Close
End Sub

 

[Julie-F]

Re : Extraction et macro, possible ?

L'erreur se produit en cellule C298 pour la valeur suivante : 10867648:40
Pourtant l'onglet étant nommé "Ensemble", celui-ci devrait être ignoré lors de l'extraction, non ?

2 types de valeurs : certaines sont inscrites en heures/minutes et doivent le rester lors de la récupération de données (format [h]:mm) d'autres sont des nombres entiers et là aussi doivent le rester lors de la récupération.
Par exemple dans le fichier "JFR2" que tu m'as fait, les valeurs en C298 sont en heures/minutes. Ainsi nous ne devons pas avoir : 1420,51805555556 mais 34092:26
Par contre en C7 il n'y a rien à modifier, la valeur récupérée teste identique.

Les entêtes initialement inscrites me permettaient surtout de savoir quelles valeurs je devais récupérer sur les 120 onglets mais le problème c'est que ce genre d'entêtes n'est pas explicite, d'où ma question.

Ta première solution permettait de récupérer les éléments du classeur jusqu'au débocage alors que je n'obtiens plus rien avec ta 2ème proposition
La macro bloque sur
Sub RecupJ2()
Dim fso As FileSystemObject
avec message d'erreur suivant : erreur de compilation. Type défini par l'utilisateur non défini

Mais merci beaucoup pour ton aide et le temps que tu y as consacré. C'est trop dure pour moi, je ne sais même pas où je dois intervenir pour obtenir un résultat.

 

[KenDev]

Re : Extraction et macro, possible ?

Oups, ah oui pour l'erreur de compilation c'est car j'ai décoché la référence Scripting . De toute façon la nouvelle macro c'est RecupJ1 à lancer depuis la feuille 1 (celle dont les entêtes sont Titre&, Titre2 etc..).

Tu peux supprimer la feuille 2 et la Sub RecupJ2, je n'aurai pas du les laisser, en plus j'ai nommé la nouvelle 1 et l'ancienne 2, mes explications au post précédent devaient être trop succinctes...

L'onglet ensemble n'est pas pris en compte avec RecupJ1. Et tu peux mettre ce que tu veux dans les entêtes, les adresses des cellules sont dans le code.
As tu regardé les commentaires? J'ai essayé de détailler mais si y'a un truc pas clair hésite pas.

Peux tu faire la liste complète des cellules qui doivent être en [h]:mm et celles en entiers ?

Je regarde pour le reste.

Cordialement

KD

 

[Julie-F]

Re : Extraction et macro, possible ?

La macro RecupJ1 bloque toujours au même endroit. Le fichier contenant les données est ouvert sur l'onglet nommé Ensemble en C298 pour la valeur suivante : 10867648:40.
Mais cette fois, à la différence de ta première macro, rien n'est extrait du tout.

Je pense que c'est cette formulation qui ne convient pas :
oWs1.Cells(Rw, j).NumberFormat = "[h]:mm"
'valeur lue est en minutes
oWs1.Cells(Rw, j) = oWb2.Worksheets(i).Range(Cr(j)) / 1440

J'ai mis les formats de cellules sur la feuille 2.

Oui j'ai lu avec attention les explications détaillées que tu as mis dans la macro et t'en remercie.

 

[KenDev]

Re : Extraction et macro, possible ?

Bonsoir,

Je pense qu'il y a du avoir confusion Sub/feuile puisque depuis la version précédente la sub ne s'occupe plus des onglets ayant plus de 3 caractères (testé et re vérifié sur "RecupV3.xls" ). Pour éviter ça il n'y a plus qu'une sub et qu'une feuille dans le nouveau classeur.

Les quelques tests sont satisfaisant de mon côté quoique certaines cases sont affichées en heures malgré un formatage vérifié en % après la sub, mais cela est sans doute du au "Classeur à récup.xls" ou en K16 on a "125789:48:00" ou "17:48:00" alors que d'après "RecupV3.xls" il doit y avoir un pourcentage. Idem pour K26.

A tester donc, tiens moi au courant. Au besoin transmet un nouveau classeur à récup avec au moins un onglet complet et représentatif des données "trouvables" dans les cas réels. Cordialement

KD

 

[Julie-F]

Re : Extraction et macro, possible ?

Je viens juste de le tester. Je rencontre un message d'erreur Errer d'exécution 5 argument ou appel de procédure incorrect (au niveau du nom du dossier)

oWs1.Cells(Rw, 2) = Left(Fich, Len(Fich) - i): Exit For

Mais cela n'a pas grande importance (information non essentielle)

Je poursuis le test. Merci encore pour ton aide

Je pense que l'erreur initiale que tu ne parvenais pas à reproduire vient du fait qu'il existe dans le classeur d'origine des onglets masqués avec des formules calculées contenues dans certaines des cellules que je dois récupérer (y compris celles en H/mn) mais à 00:00 et donc une erreur au niveau du % (#DIV/0!) Je viens seulement de m'en apercevoir parce que ta nouvelle macro bloquée à nouveau stoppant sur l'une d'elles.
Il m'est impossible d'intervenir sur le classeur d'origin, comment dès lors, peut-on contourner ce problème de feuilles masquées ? Peut on les exclure directement dans la macro ?