extraire sheet de +eurs fichiers ds disc dur

[XV]

Bonjour à tous,

Là c'est du technique!! ...je crois

J'ai créé un outil de saisi via userform qui alimente une feuille 'explanations' colonne A à E sur 200 lignes.

Il y a 10 sites qui saisissent des données via l'Userform mais chaque entité a un fichier spécifique ds un dossier spécifique dont la racine commune est le dossier 'budget' ds le disque dur X

Je veux créer une; macro qui cherche ds le disque dur X les feuilles 'explanations' de divers fichiers et sous dossiers et qu'elle les regroupe ds un seul fichier tout cela sur des fichiers fermés et non regroupés ds un 'dossier' commun. D'où chercher sur le disque 'X'.

Est-ce possible???

Si ça peut aider, j'ai la macro suivante qui réunie toutes les feuilles des classeurs actifs mais je veux que la macro fonctionne sur des classeurs fermés et sur des feuilles spécifiques (feuilles 'explanations') situées ds le dossier 'budget' du disque 'P' mais sans + d'explications sur le chemin des fichiers.

Sub CopyFeuilles()
Dim i As Byte
Dim j As Byte
Dim Wb As Workbook
Dim Ws As Worksheet

Application.ScreenUpdating = False
For i = 1 To Workbooks.Count
If Workbooks(i).Name <> 'Base.xls' Then
For j = 1 To Workbooks(i).Worksheets.Count
Workbooks(i).Sheets(j).Copy Before:=Workbooks('Base.xls').Sheets('Feuil1')
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub


Merci à tous pour votre aide dont j'ai bien besoin...encore une fois


XV


:whistle:

 

[Bebere]

bonjour
lire données ds fichier fermé
Nécessite une référence à Microsoft ActiveX Data Objects 2.x Library

2 méthodes,commenter ou décommenter la ligne
commencant par GetExternalData

Sub LitDatas01()
Dim Fich$, Arr

Fich = 'E:\\Dossier\\Fichier.xls'
'1 récup des données à partir de l'adresse d'une plage de cellules
GetExternalData Fich, 'NomFeuille', 'G5:G8', False, Arr
'2 récup des données à partir du nom d'une plage de cellules ()
' GetExternalData Fich, '', 'plagenommée', False, Arr

With ThisWorkbook.Sheets('Feuil1')
.Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
'.Columns('A:C').AutoFit
'MsgBox valeur(0)
End With
'Sheets('Feuil2').Columns('A:C').AutoFit
End Sub

'renvoie les valeurs d'une plage de cellules contigües (srcRange)
'd'une feuille (srcSheet) d'un fichier (srcFile) fermé
'dans un tableau (outArr)
'le paramètre TTL indique si la plage a ou non une ligne d'entêtes
Sub GetExternalData(srcFile As String, _
srcSheet As String, _
srcRange As String, _
TTL As Boolean, _
outArr As Variant)
'écrit par Hector Miguel, merçi
Dim myConn As ADODB.Connection, myCmd As ADODB.Command
Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
Dim Arr

Set myConn = New ADODB.Connection
If TTL = True Then HDR = 'Yes' Else HDR = 'No'
myConn.Open 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & srcFile & ';' & _
'Extended Properties=''Excel 8.0;' & _
'HDR=' & HDR & ';IMEX=1;'''
Set myCmd = New ADODB.Command
myCmd.ActiveConnection = myConn
If srcSheet = '' _
Then myCmd.CommandText = 'SELECT * from `' & srcRange & '`' _
Else myCmd.CommandText = 'SELECT * from `' & srcSheet & '$' & srcRange & '`'
Set myRS = New ADODB.Recordset
myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
myRS.MoveFirst
Do While Not myRS.EOF
For RS_n = 1 To myRS.RecordCount 'lignes
For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
Next
myRS.MoveNext
Next
Loop
myConn.Close
Set myRS = Nothing
Set myCmd = Nothing
Set myConn = Nothing

outArr = Arr

End Sub

bonne chance

au revoir

:huh:

 

[Bebere]

re
mauvaise syntaxe ligne e:....
e:\\dossier\\fichier.xls
à+ B)

 

[MichelXld]

bonjour

ci joint un autre exemple qui boucle sur tous les classeurs fermés du répertoire 'X\\monRepertoire' , et importe les données des feuilles 'Explanations' pour chaque classeur

le classeur contenant cette macro ne doit pas etre dans le meme répertoire . cet exemple ne gere pas les erreurs si l'onglet 'Explanations' n'existe pas dans les classeurs fermés

Option Explicit
Option Base 1

Sub ChercheFichiersFermesV02()
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Fichier As String, Direction As String, texte_SQL As String
Dim X As Integer, NbFichiers As Integer
Dim Tableau() As String

Application.ScreenUpdating = False

Direction = Dir('X\\monRepertoire\\*.xls') 'boucle sur les fichiers du répertoire
Do While Len(Direction) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
Direction = Dir()
Loop

If NbFichiers > 0 Then
For X = 1 To NbFichiers 'boucles sur les classeurs

Fichier = ThisWorkbook.Path & '\\' & Tableau(X)

Set Source = New ADODB.Connection
Source.Open 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
'data source=' & Fichier & ';' & _
'extended properties=''Excel 8.0;'''

'cet exemple ne gere pas les erreurs si l'onglet 'Explanations' n'existe pas
'dans les classeurs fermés du répertoire 'X\\monRepertoire'
texte_SQL = 'SELECT * FROM [Explanations$]'

Set Rst = New ADODB.Recordset
Set Rst = Source.Execute(texte_SQL)

ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'ajout feuille dans classeur
ActiveSheet.Name = 'import' & X 'renomme la feuille créée
ActiveSheet.Range('A1').CopyFromRecordset Rst 'import des données

Rst.Close
Source.Close

Next X
End If
Application.ScreenUpdating = True
End Sub

bonne soiree
MichelXld

Message édité par: MichelXld, à: 22/06/2005 18:13

 

[XV]

Merci à tous,

Ben je vois qu'il y a des gens qui ont réponse à tout!!!

je vais tester cela ce soir et je vous tiens au courant

XV

 

[XV]

Rebonsoir,

j`essai d`avancer ;ais c`estm pas super facile malgre l`aide aue vous m`apportez.

Quand je fais defiler la macro, je bloque sur :

Dim myConn As ADODB.Connection

Pouvez vous me dire a quoi ce texte VBA correspond car je ne sais pas si je dois l`adapter ??

Autre soultion : un fichier joint avec un exemple comprenant 2 fichiers contenant 2 feuilles nommees de la meme facon ('explanation' c`est mon nom de feuille mais je suis ouvert a tout autre nom ). J`enregistre ces 2 fichiers sous C/ocuments and Settings ou autre chemin que je cree sur mon dique (si vous avez un exemple existant avec un autre chemin) et je le teste. Je sais c`est lourd mais bon ...


Merci en tout cas pour vos conseils

XV

 

[michel_m]

Bonsoir XV Bebere Michel

Dans l'éditeur VBE outils-références coche la bibliothèque
Microsoft ActiveX Data Objects 2.x Library

x dépend de ta version excel

La proposition de Michel marche mais il faut que tes classeurs-source soient dans le m^m répertoire
Excuse moi bebere mais je regarderai demain car je ne connais pas ta méthode et ca m'intéresse

Bonne fin de soirée

Michel

 

[XV]

Merci Michel_m,

en effet ca avance mais je ca marche pas au final, je dois rater quelque chose car j`ai bien note que ca devrait marcher...

le chemin de mon fichier est :

C:\\Documents and Settings\\Test Macro

La macro est enregistree ds le classeur 1

et ds le texte de la macro de Michel j`ai modifie cela

Direction = Dir('C\\Documents and Settings\\Test Macro*.xls')

J`ai cree 2 fichiers contenant chacun 1 feuille 'Explanations' et ces 2 fichiers sont nommes Source 1 et Source 2. L`ensemble (Classeur 1, Source 1 et Source 2) est enregistre ds le dossier Test Macro

donc cela donne :


Sub ChercheFichiersFermesV02()
Dim Source As ADODB.Connection
Dim myConn As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Fichier As String, Direction As String, texte_SQL As String
Dim X As Integer, NbFichiers As Integer
Dim Tableau() As String

Application.ScreenUpdating = False

Direction = Dir('C\\Documents and Settings\\Test Macro\\*.xls') 'boucle sur les fichiers du répertoire
Do While Len(Direction) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
Direction = Dir()
Loop

If NbFichiers > 0 Then
For X = 1 To NbFichiers 'boucles sur les classeurs

Fichier = ThisWorkbook.Path & '\\' & Tableau(X)

Set Source = New ADODB.Connection
Source.Open 'Provider = Microsoft.Jet.OLEDB.4.0;' & _
'data source=' & Fichier & ';' & _
'extended properties=''Excel 8.0;'''

'cet exemple ne gere pas les erreurs si l'onglet 'Explanations' n'existe pas
'dans les classeurs fermés du répertoire 'X\\monRepertoire'
texte_SQL = 'SELECT * FROM [Explanations$]'

Set Rst = New ADODB.Recordset
Set Rst = Source.Execute(texte_SQL)

ThisWorkbook.Sheets.Add _
after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'ajout feuille dans classeur
ActiveSheet.Name = 'import' & X 'renomme la feuille créée
ActiveSheet.Range('A1').CopyFromRecordset Rst 'import des données

Rst.Close
Source.Close

Next X
End If
Application.ScreenUpdating = True
End Sub

Je vois pas ce qui cloche. Desole

Merci pour la contribution de tous
XV

 

[MichelXld]

bonjour XV , Bebere et mon ami Michel

dans ton premier message les onglets sont nommés 'explanations' et dans ton message de 22:57 c'est 'explanation' : il faut etre précis sinon ça ne pourra pas marcher...

quand tu dis 'ca marche pas' : ça bloque sur quelle ligne ? quel est le message d'erreur ?

as tu pris en compte les remarques de mon 1er message
la macro boucle sur tous les classeurs fermés du répertoire

'X\\monRepertoire\\*.xls'

( chemin à adapter )
le classeur contenant cette macro ne doit pas etre dans le meme répertoire que les claseurs fermés
cet exemple ne gere pas les erreurs si l'onglet 'Explanations' n'existe pas dans les classeurs fermés

quand tu écris

Direction = Dir('C:\\Documents and Settings\\Test Macro\\*.xls')

, le répertoire indiqué doit correspondre à l'emplacement des classeurs fermés

dans ta demande initiale tu indiques que tes fichiers sont dans différents répertoires , mais tu pourrais faire un premier essai sur un répertoire précis et ainsi vérifier si la procedure fonctionne


ci joint un autre exemple


bonne journée
MichelXld


[file name=importFeuillesClasseursFermes.zip size=27565]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/importFeuillesClasseursFermes.zip[/file]

Message édité par: MichelXld, à: 23/06/2005 06:05

 

[XV]

Salut Michel,

je vois que tu commences tôt ta journée!!! ou alors tu ne dors pas.

Je te remercie, les feuilles sont bien nommees 'Explanations'.

Enfait la macro s'éxécute mais pas de feuiles Explanations ds mon 'classeur 1'.

Je vais essayer ton exemple, je pense que je vais y arriver!!!

Je vous tiens au courant dés ce soir.

Pour l'exmeple de Bebere, je vais voir ça ce WE.

Merci a tous

XV

 

[michel_m]

bonjour à tous

Vite fait en attendant la Nième réunion de la semaine...

Le fichier 'classeur1' ne doit pas être dans me m^repertoire que les classeurs source

A+
Michel at work

 

[XV]

Rebonjour

ben ton exemple je le connaissais...faut dire que je suiçs svt sur le site à traquer des infos. Merci

Mais je sais où ca bloque :

Set Rst = Source.Execute(texte_SQL)
Message : Le moteur de base de donnees Microsoft Jet n'a pas pu trouver l'objet 'explanations'.

1/ Dois je mettre le dollar ds

texte_SQL = 'SELECT * FROM [Explanations$]'

D'ailleurs si l'efface ça ne change rien à mon probleme mais bon. Il sert a quoi ce $

2/ les feuilles Explanations existent et la boucle 'Loop' fait bien une boucle sur les 2 fichiers dont je dispose, chacun ayant la feuille 'Explanations'

Donc je vois pas où ça bloque.


XV

 

[Bebere]

bonjour

il faut le '$' pour sql
par contre la syntaxe devrait être à mon avis
[Explanations] & '$' pcq écrit comme çi dessous
[Explanations$] n'existe pas

texte_SQL = 'SELECT * FROM [Explanations$]'

au revoir à tous

 

[Bebere]

rebonjour à tous

j'ai téléchargé le fichier et essayé
fonctionnement parfait tel que
oublier mon précédent blabla
essayé sous excel2000 win98se
à+

 

[Bebere]

rebonjour à tous

j'ai adapté la procédure que j'emploie à votre fichier
voir pièce jointe

à+ B) [file name=synthese_20050623131741.zip size=36378]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/synthese_20050623131741.zip[/file]