Excel Macro Extraction Données

Résolu

Tableau
Macro
Classeur

Martin -
Faren - 4 mai 2016 à 14:59

Bonjour,

Je suis assez débutant en macros excel, et j'aimerais obtenir de l'aide pour créer une macro d'extraciton sur excel. J'ai plusieurs fichiers avec 11 colonnes et 33 lignes tous sous le meme format et j'aimerais créer un fichier distinct qui va extraire les données dans les tableaux de mes fichiers pour les mettres un à la suite de l'autre dans le classeur source. Tous les fichiers sont au même endroit sur mon ordinateur.

Le but étant de mettre éventuellement des filtres et retrouver l'information réunie dans un même fichier plus rapidement.

Merci beaucoup de votre dévoument

Martin

Afficher la suite

Répondre (28) Posez votre question

Répondre (28)

A voir également:

Macro extraire des données d'un tableau excel vers un autre tableau
Tableau word - Guide
Trier un tableau excel - Guide
Tableau ascii - Guide
Imprimer un tableau excel - Guide
Tableau croisé dynamique - Guide

28 réponses

Réponse 1 / 28

Meilleure réponse

La meilleure réponse est la réponse qui a été validée par nos équipes.

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
Eh bien, je pense qu'il est préférable d'ouvrir un nouveau poste avec une explication et si possible le fichier sur https://www.cjoint.com/ et poster le lien.

Moncef

Bonjour,

voici les fichiers http://cjoint.com/?BKhq5upu2WM.

Réponse 2 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bonjour,

J'ai plusieurs fichiers
Combien?

Réponse 3 / 28

Martin

10-15 par semaine...

j'ai vu sur internet quelqu'un qui faisait a peu près le même genre d'action avec un bouton de transfert...

Martin

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Oui c'est possible.
Le tout est de savoir combien de données va "drainer" à terme ton fichier excel.
Là, selon ton indication et à condition d'un fichier regroupement de données par an ça fait tout de même :
15*52*33 = 25 740 lignes et 11 colonnes.
Ca pourrait encore passer.
J'te bricole une solution vite fait et tu testes.
OK?

Réponse 4 / 28

Martin

Parfait merci beaucoup :)

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Petite question importante, tes fichiers sont dans le même répertoire. Ok.
Mais toutes les semaines, tu ajoutes des fichiers dans le même répertoire? Dans un autre?

Réponse 6 / 28

Martin

Dans le même

Réponse 7 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Voici un premier jet :

https://www.cjoint.com/?BChq5ZwmMN1

Le code :

Option Explicit

Sub ExtractionDonnéesClasseursMultiples()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String

With Sheets("Extraction")
    .Cells.Clear
End With
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    fichier = Dir(Chemin & "*.xls")
    With Sheets("Extraction")
        .[A1] = fichier
    End With
    Do While Len(fichier) > 0
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1:$L$50"
            With Sheets("Feuil2")
                .[A1:L50] = "=Plage"
                .[A1:L50].Copy
                Sheets("Extraction").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End If
        fichier = Dir()
        With Sheets("Extraction")
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = fichier
        End With
    Loop
End If
With Sheets("Feuil2")
    .[A1:L50].Clear
End With
End Sub

Réponse 8 / 28

Martin

Je test, Merci beaucoup encore pijaku

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

De rien.
Il y a plein de défaut à cette méthode.
Par exemple : les cellules vides sont remplacées par un 0...
Essaye et reviens pour les adaptations...

Martin

Ok,
Je peux créer un bouton de commande et y associer ce code ?

Réponse 9 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Bien sur...
Ci-joint version 2, sans les "zéros" des cellules initialement vides...

Réponse 10 / 28

Martin

j'obtiens un bug à la ligne ci dessous :

.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Application.Transpose(Tabl)

Faut-il que j'adapte quelque chose ?

Réponse 11 / 28

Martin

Mes fichiers a extraires s'appellent Abcde1, Abcde2, Abcde3 et les feuilles dans ces fichiers qu'il faut extraire s'appellent toutes Feuil1, si ça peut t'aider ...

Merci pour ton temps

Martin

Réponse 12 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Re-
j'obtiens un bug à la ligne ci dessous :

.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Application.Transpose(Tabl)

Faut-il que j'adapte quelque chose ?

Je ne comprends pas, je viens de re-tester cela fonctionne.

Peut être du à un de tes fichiers ou aux données qu'il contient. Peux tu me faire passer un exemple ici même?

Réponse 13 / 28

Martin

La feuille extraction me donne :

en A1 A2 et A3, à la fin de l'exécution :

Extraction.xls
Abcde1.xls
Abcde2.xls
Abcde3.xls

Mais il ne copie pas les tableaux comme j'aurais espéré...

Réponse 14 / 28

Martin

Il me demande d'enregistrer les fichiers à extraire à la fin de l'exécution, maisles tableaux ne sont pas copiés dans le fichier source... lorsque j'enregistre les fichiers j'obtiens ce que j'ai écris dans la dernière réponse ^

Les fichiers à extraire contiennent des listes (validations de données) et les différences de couleurs de cellules.

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut,
Peux tu me transmettre, grâce à https://www.cjoint.com/ ou par mail (tu trouveras mon adresse perso en fouillant dans mon profil), un exemple de fichier.
Tu va sur cjoint, tu créées un lien vers ton fichier, copie ce lien et viens le coller ici dans une réponse.

Réponse 15 / 28

Martin

Voici le fichier :
http://cjoint.com/confirm.php?cjoint=BCio1q6QOhu

Voici le fichier source :
http://cjoint.com/confirm.php?cjoint=BCio2BbEqIP

Le but étant que lorsque j'appuie sur transférer le fichier source copie et colle le tableau dans sa feuille d'extraction.

Merci pijaku

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Je ne peux pas ouvrir les fichiers .xlsm... Donc ne peux pas ouvrir abcde...
Peux tu l'enregistrer sous, type de fichier : classeur excel 97-2003 et me le transférer à nouveau...

Réponse 16 / 28

Martin

http://cjoint.com/confirm.php?cjoint=BCipt1URiI1

J'ai été obligé de supprimer la deuxième feuille puisqu'elle était trop lourde. Il s'agit d'une feuille de référence pour les projets.

Réponse 17 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

En effet, bien peu de choses peuvent empêcher le bon fonctionnement d'une procédure...
Ici, il suffit de préciser la feuille. Soit :

Tabl = Sheets("Feuil1").Range("A9:K42") ' A ADAPTER SI PLUS DE 11 Colonnes et 33 Lignes...

au lieu de :

Tabl = Range("A9:K42") ' A ADAPTER SI PLUS DE 11 Colonnes et 33 Lignes...

ton fichier extraction

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour pijaku,
Je n'avais pas remarqué m'est il me semble que c'était votre code :
https://forums.commentcamarche.net/forum/affich-24654554-macro-extraction-donnees-excel#1
Amicales salutations.
Le Pingou

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut Le Pingou,

Oui je viens de voir ce doublon. Et oui, par moment je ne réponds pas assez rapidement...

On peux peut être se tutoyer non?
Franck

Martin

Merci Beaucoup de votre temps, je suis très satisfait, c'est exactement ce que j'espérais :)

Bonne journée

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

as tu supprimé comme te le disais fort justement Le Pingou la seconde :

With Sheets("Extraction")
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Tabl
End With

Martin

Oui

Réponse 18 / 28

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Parfait donc.
A+

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour pijaku,

A la question : On peux peut être se tutoyer non? ; depuis le temps que l'on se croise sur le site et si vous êtes le violoniste Frank je pense que Oui.
Je te souhaite une excellent fin de journée.
Amicales sautations
Le Pingou

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Salut
Yes I'm this Franck.

On s'connait???

A+

Franck

Le Pingou Messages postés 12249 Date d'inscription Statut Contributeur Dernière intervention 1 458

Bonjour,
Non, cependant, il y a un certain temps tu m'avais invité à l'occasion d'un MP à jeter un oeil sur 4 Smyki.
Maintenant les choses sont à leurs places dans ... et c'est super.
A une prochaine.
Salutations amicales
Le Pingou

Réponse 19 / 28

Martin

Oh, une dernière chose,

J'ai remarqué qu'il transposait les colonnes en lignes, est-ce possible qu'il ne le fasse pas ?

seulement copier les lignes en lignes et les colonnes en colonnes ?

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

Vois ce qui te convient le mieux...

With Sheets("Extraction")
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Tabl
End With

With Sheets("Extraction")
    .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Application.Transpose(Tabl)
End With

Réponse 20 / 28

Martin

Rebonjour,

Je ne sais pas si j'aurais du créer un nouveau post, mais j'avais en fait deux questions.

La première est-ce possible de ne pas copier les lignes sans écritures ?

La deuxième est-ce possible de ne pas effacer les cellules au début de l'extraction, mais bien de poursuivre à la suite des dernières lignes extraites si l'on fait plusieurs extractions en série ?

Merci de ton service après-vente pijaku :)

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

demain?

Martin

j'ai réglé mon problème avec les filtres et masquer les cellules vides automatiquement.

J'ai aussi changé le .clear cells pour un DerniereLigne = Range("A65536").End(xlUp).Row

et tout fonctionne très bien

Répondre Posez votre question

Votre réponse

Discussions similaires

Macro Vba Extraction de données en fonction de la date sous Exce

Vdkvodka -
nanas -

16 réponses

VBA fermer un fichier Excel

JP -
JP -

5 réponses

Enregistrement Fichier Excel avec des Macros

galaxy20100 -
GHERRI -

7 réponses

Comment supprimer certaines macro perso

Gui -
Gui -

2 réponses

macro dans classeur macro personnelles

JeannotLapin -
JeannotLapin -

4 réponses

Impossibilité enregistrement macro Excel 2010

mago92 -
to -

7 réponses

Devenez membre en quelques clics

Connectez-vous simplement avec ceux qui partagent vos intérêts
Suivez vos discussions facilement et obtenez plus de réponses
Mettez en avant votre expertise et aidez les autres membres
Profitez de nombreuses fonctionnalités supplémentaires en vous inscrivant

S'inscrire