Extraire certaines cellules de plusieurs fichiers fermés

salland

XLDnaute Nouveau
Bonjour,
je cherche à récupérer les cellules M12 à Q12 de ces 3 fichiers excel (qui sont fermés et dans un meme repertoire) et à les rapatrier dans un quatrieme fichier (de A1 a E1 pour les data du 1er fichier; de A2 à E2 pour les data du 2eme fichier; de A3 à E3 pour le troisieme.....)
Je vous ai mis 3 fichiers mais j'en ai une multitude .....

Merci a tous
 

Pièces jointes

  • L00000659.xls
    218 KB · Affichages: 48
  • L00000660.xls
    213 KB · Affichages: 44
  • L00000661.xls
    213 KB · Affichages: 39
  • L00000659.xls
    218 KB · Affichages: 43

Lolote83

XLDnaute Barbatruc
Re : Extraire certaines cellules de plusieurs fichiers fermés

Salut Salland,
Pour ce faire, j'utilise la macro suivante pour lire des données dans un fichier fermé.
Code:
Sub LireFichierFermé()
    Dim texte_SQL As String
    Dim xChemin As String
    Dim xFichier As String
    Dim xOnglet As String
    Dim xPlage As String
    Application.ScreenUpdating = False
    'Définition des variables
        xChemin = "Nom du chemin"
        xFichier = "Nom du fichier" '(ne pas oublier l’extension .xls ou xlsx ou xlsm ....)
        xOnglet = "Nom de l'onglet"
        xPlage = "M12:Q12"
    'Connexion ADO
        Set Source = CreateObject("ADODB.Connection")
        'Avant XL 2007
            'Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & xChemin & "\" & xFichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
        'Après XL 2007
        If Right(xChemin, 1) = "\" Then
            Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xChemin & xFichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"       'IMEX=1";
        Else
            Source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xChemin & "\" & xFichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"       'IMEX=1";
        End If
    'Exerce la requete ADO sur les donnée à recopier
        texte_SQL = "SELECT * FROM [" & xOnglet & "$" & xPlage & "]"
        Set Requete = CreateObject("ADODB.Recordset")
        Set Requete = Source.Execute(texte_SQL)
    'Ecriture des données lues dans le fichier en cours
        ActiveSheet.Range("A1").CopyFromRecordset Requete    'Les données seront copiées en cellule A1 de l'onglet actif
    'Ferme la requete
        Set Requete = Nothing
        Set Source = Nothing
        Application.ScreenUpdating = True
End Sub

Il faudra faire une boucle sur tes fichiers et le tour est joué.
@+ Lolote83
 

salland

XLDnaute Nouveau
Re : Extraire certaines cellules de plusieurs fichiers fermés

Bonjour et merci pour cette réponse.
Je ne suis vraiment pas fort en langage macro!!!!
Est ce qu'il vous serez possible de m'envoyer le fichier excel avec cette macro ?
Je colle ce fichier dans mon répertoire et je lance la macro....
Est ce possible?

Encore merci
 

Lolote83

XLDnaute Barbatruc
Re : Extraire certaines cellules de plusieurs fichiers fermés

Salut,
Comme tu le dis :
Je ne suis vraiment pas fort en langage macro!!!!
Est ce qu'il vous serez possible de m'envoyer le fichier excel avec cette macro ?
Je colle ce fichier dans mon répertoire et je lance la macro....
Le fichier que je vais t'envoyer sera à l'identique de la macro décrite plus haut et pour laquelle il te faudra modifier quelques lignes. Donc même si je d’envois le fichier, cela ne marchera pas chez toi.

Il faut que tu modifie les ligne suivantes:
Code:
'Définition des variables
        xChemin = "Nom du chemin"
        xFichier = "Nom du fichier" '(ne pas oublier l’extension .xls ou xlsx ou xlsm ....)
        xOnglet = "Nom de l'onglet"
        xPlage = "M12:Q12"
'Définition des variables
xChemin = "Nom du chemin"
xFichier = "Nom du fichier" '(ne pas oublier l’extension .xls ou xlsx ou xlsm ....)
xOnglet = "Nom de l'onglet"
xPlage = "M12:Q12"
Exemple pour le Chemin: M:\A-FORUM\2016 à écrire entre "
Exemple pour le fichier : L00000659.xls à écrire entre "
Exemple pour l'onglet : AS9617A-27 ed03 Controle FAB, c'est le nom de l'onglet du fichier ou seront lues les données, toujours à écrire entre "
Exemple pour la plage : M12:Q12 à écrire entre "

Code:
'Ecriture des données lues dans le fichier en cours
        ActiveSheet.Range("A1").CopyFromRecordset Requete    'Les données seront copiées en cellule A1 de l'onglet actif
ActiveSheet.Range("A1").CopyFromRecordset Requete 'Les données seront copiées en cellule A1 de l'onglet
ensuite, les données lues seront copiées à partir de la cellule A1 du fichier ouvert.
Voili voilà.
En espérant que ces informations te seront utiles pour modifier la macro et faire tourner ceci sur ton programme
@+ Lolote83
 

Discussions similaires

Statistiques des forums

Discussions
312 196
Messages
2 086 092
Membres
103 116
dernier inscrit
kutobi87