Créer une macro pour recuperer certaines lignes de 750 fichiers

[cathfree]

Bonjour,
Je suis complétement novice en VBA, et je voudrais créer une macro pour récupérer dans un fichiers cible, certaines lignes de 750 fichiers sources. Je voudrais aussi ajouter en face de chaque ligne, le nom du fichier source. Je joins un document pour compléter l'explication. En espérant que vous pourrez m'aider ! Merci d'avance.
Cath

 

[CHALET53]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

bonjour,

Des spécialistes devraient y arriver. Il faut peut-être donner un peu plus d'informations
Les fichiers sources sont-il tous dans le même répertoire et seuls dans ce répertoire ?
Ont-ils un nom structuré toujours de la même façon?
Les infos sont-elles toujours dans la feuille 1

Pour identifier la 1ère et la dernière ligne d'information (à partir de l'exemple Facture 1)
Dans la colonne B, n'y a-t-il plus aucune info au dessous du chiffre 10
n'y a-t-il aucune info au dessus du chiffre 14 ?

A tout le moins, if faut une structure identique sur toutes les factures (et en préciser la description)

750 fichiers: c'est énorme

a+

 

[cathfree]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

Bonjour,

Merci beaucoup pour cette réponse.
Voi les informations supplémentaires :

- Oui les fichiers sources sont tous dans le même répertoire "Factures" (et seuls dans ce répertoire)
- Leur nom est structuré toujours de la même façon année-mois-numéro (ex : 2009-06-012)
- Les infos sont toujours dans la feuille 1

Je joins 2 exemples réels de fichiers sources.

J'ai deja utilisé la macro, qui recopie la zone qui m'intéresse, mais si je pouvais rajouter sur les memes lignes (tres important) le nom du fichier source, je serai sauvée.

Range("A1").Select 'sélectionner la cellule de début
Chemin = "C:\Documents and Settings\Bureau\Factures\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") '
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("A1").Select
Range("A32:F38").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub

750 fichiers représentent plusieurs années ! Mais je peux évidemment le faire en plusieurs fois.
Merci de votre aide.

 

[CHALET53]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

bonsoir,

s'il ne te manque plus que le nom du fichier :
Lorsque ton fichier est ouvert, tu mets dans une variable le nom de ce fichier
nom=ActiveWorkbook.Name
tu recopies nom dans ton fichier résultat à l'endroit qui te convient
a+

 

[cathfree]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

Lorsque ton fichier est ouvert, tu mets dans une variable le nom de ce fichier
nom=ActiveWorkbook.Name
tu recopies nom dans ton fichier résultat à l'endroit qui te convient
a+

Merci. mais je ne sais comment faire pour que, dans la macro, pour chaque ligne recopiée, le nom de chaque fichier source soit recopié sur la même ligne...

 

[CHALET53]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

bonjour,

je suis indisponible pour l'instant, je regarde cela dès que possible

a+

 

[CHALET53]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

Re,

copie cette procédure dans ton fichier : fichiers cibles.xls
Si ton fichier récapitulatif ne s'appelle pas fichiers cibles.xls, modifie les éléments concernés dans la procédure

Sub RECAP()
Range("A:E").ClearContents
derligne = 10
Application.ScreenUpdating = False
Range("B" & derligne).Select
chemin = "C:\Documents and Settings\Bureau\Factures"
Direction = Dir(chemin & "\*.xls")
nbfic = 0
While Direction > ""
If Direction = "fichiers cibles.xls" Then GoTo suite
nbfic = nbfic + 1
Workbooks.Open Filename:=chemin & "\" & Direction
nom = ActiveWorkbook.Name

Range("A32:F38").Copy
ThisWorkbook.Activate
Range("A" & derligne) = nom
derligne = derligne + 1
Range("B" & derligne).Select
ActiveSheet.Paste
Windows(Direction).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
derligne = Range("A65536").End(xlUp).Offset(1, 0).Select + 5
'MsgBox Nom_proj(nbfic) & " = " & nbfic
suite:
Direction = Dir()

Wend
End Sub

 

[herve62]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

Bonjour
Par fois laisser un bout de programme pour un Pb est vite ramassé par les utilisateurs
C'est bien au moins parfois ce que l'on developpe est Utile !!
Depuis la sem dernière je l'ai amélioré car j'ai pas fini l'appli du membre de ce forum
Pour éviter de changer en "dur" le chemin , on le rentre , et puis teste le chemin ou si un fichier données est déjà ouvert , le nom de son fichier (sans .xls) se met en ligne 5 .... la suite comme toi elle recupère des données de 35 fichiers
A toi d'adapter

 

[CHALET53]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

Bonjour Hervé,

Il m'arrive effectivement de conserver des éléments de ce forum quand je les trouve bien faits. j'ai sans doute oublié d'y faire référence dans ce message (Avec toutes mes excuses)
Il m'arrive aussi de voir des forumeurs qui utilisent et apprécient mes modestes contributions. J'en suis ravi. Peu importe que je sois cité ou pas : je ne m'en offusque pas

Bon courage à tous

... et merci encore aux nombreux contributeurs de ce forum

a+

 

[herve62]

Re : Créer une macro pour recuperer certaines lignes de 750 fichiers

Bonjour Chalet
Moi aussi ça m'est égal je ne cherche pas à être cité ( ca sert à rien), mais je récupère aussi des trucs bien fait .. ca peut servir : c'est le cas d'il y a 1h pour USF qui se ferme pas , j'ai mis un bout de code qui m'a servi ....autant que cela profite !!!!
Là c'est parceque c'était tout Frais , que cela a fait Tilt ( surtout avec les noms de variables peu communs !!)
ESpèrons que Cathfree se manifeste , car c'est plûtot là que ca énerve .... tu aides ....et plus personne .... le Merci est encore souvent un mot inconnu !!!