Excel Macro Extraction Données Résolu

Question

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
Configuration: Windows XP / Internet Explorer 8.0

Le Pingou · Accepted Answer

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.

pijaku · Answer

Bonjour,

J'ai plusieurs fichiers 
Combien?

Martin · Answer

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

Martin · Answer

Parfait merci beaucoup :)

pijaku · Answer

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?

Martin · Answer

Dans le même

pijaku · Answer

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

Martin · Answer

Je  test, Merci beaucoup encore pijaku

pijaku · Answer

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

Martin · Answer

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 ?

Martin · Answer

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

pijaku · Answer

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?

Martin · Answer

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

Martin · Answer

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.

Martin · Answer

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

Martin · Answer

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.

pijaku · Answer

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

pijaku · Answer

Parfait donc.
A+

Martin · Answer

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 ?

Martin · Answer

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

Le Pingou · Answer

Bonjour,
Juste en passant, remplacer ceci : Range("A65536").End(xlUp).Row
Par cela qui est indépendant de la version Excel :
(Cells(Rows.Count, 1).End(xlUp).Row)

pijaku · Answer

Bonjour tout le monde,
@Le Pingou, en complément de ta réponse : https://forums.commentcamarche.net/forum/affich-37622001-vba-detection-de-cellule-vide-ligne-colonnne
@Martin : tant mieux, bonne route.
A+

Moncef · Answer

Bonjour,

Je souhaite utilisé la même macro qui répond parfaitement à mon besoin sauf que j'ai besoin de faire que coller et pas transposé

 .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 2), UBound(Tabl, 1)) = Application.transpose(Tabl)

Merci d'avance.

Le Pingou · Answer

Bonjour, 
Remplacer : .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(Tabl, 1), UBound(Tabl, 1)) = Tabl
Par : .Range("A" & Rows.Count).End(xlUp).Offset(0, 0).Resize(UBound(Tabl, 1), 2) = Tabl 
  
  
Salutations. 
Le Pingou

Le Pingou · Answer

Bonjour,
Eh bien, je pense qu'il est préférable d'ouvrir un nouveau poste avec une explication sur le pourquoi devoir mettre le nom des feuilles dans une cellule ... !
Extraire de plusieurs classeurs ..... ?
Plusieurs feuilles par classeurs... ?
Note : si vos données sont toujours dans la même plage de la feuille, il suffit de faire une boucle sur les feuilles du classeur.
  
  
Salutations. 
Le Pingou

Darrodge · Answer

Bonjour, 

Je me permets de réouvrir ce post car j'ai un problème semblable à celui qui a été résolu ici. Je m'explique : 

Je dois réaliser une macro permettant de récupérer les données de plusieurs feuilles Excel, contenues dans le même dossier, et de les coller dans une feuille appelée "Base de données". 

Les données que je souhaite récupérer dans les feuilles sont situées en colonne N, et je souhaite qu'à chaque fois qu'une colonne est copiée dans la base de données, on incrémente le nombre de colonnes afin de copier les données de la feuille suivante dans la colonne suivante.
J'ai essayé de reprendre la macro qui était dans la discussion ci-dessus, mais je n'arrive pas à réorganiser les données comme je le souhaite. 

Merci par avance pour vos éclaircissements :)

Le Pingou · Answer

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

Faren · Answer

Bonjour,

Je pense que je vais avoir besoin d'éclaircissements par rapport à ce problème traité pour m'aider dans la mise en place de ma Macro.

http://www.cjoint.com/c/FEemMImNp2C

Je remplis toutes les semaines un tableau de prévisions de ventes et qui est enregistré dans un dossier (1 dossier par an). En parallèle j'ai un fichier journalier où je remplis le réel. 
Toutes les semaines j'ai besoin de récupérer les valeurs de plusieurs colonnes non attenante de mon fichier prev de ventes et les copier sur mon journalier.
Les fichiers ont la même structure mais je voudrais par sécurité utiliser un fonction de recherche qui comparera la colonne A des 2 fichiers et collera les valeurs en face des bonnes références d'article.

Résumé: 
En lançant la macro de mon fichier nommé "Journalier"
Je veux qu'une boite de dialogue s'ouvre et me propose de sélectionner le fichier de comparaison. 
Suite a ceci, la macro va copier pour chaque références les valeurs des colonnes  EV FJ FX GL GZ et HN du fichier ouvert et le coller sur mon fichier journalier.

En espérant avoir été clair. Si quelqu'un a la possibilité de m'aider ;) Ce serait vraiment très simpa.

Excel Macro Extraction Données

28 réponses

Discussions similaires

Newsletters