récup feuille classeur fermé

M

MichelXld

XLDnaute Barbatruc

• 4 Avril 2006

• #2

bonjour Vince

Avec l'aide d'une macro je souhaite récupérer dans un nouveau classeur nommé 'bureau 1' l'onglet du classeur 'site 1' à savoir 'étude_01'
et ainsi de suite pour le classeur nommé 'bureau 2'

Cliquez pour agrandir...

peux tu repréciser le résultat que tu souhaites obtenir .


bonne journée
MichelXld

Message édité par: michelxld, à: 04/04/2006 05:57

 

Vote positif 0 Vote négatif

V

vince

Guest

• 4 Avril 2006

• #3

Bonjour
L'objectif de la macro est de recenser dasn un premier les feuilles de différents classeurs fermés ayant pour point commun une feuille comportant le numéro '01' est d'importer chacune de ces feuilles dans un nouveau classeur qu'on appellera 'global 01 ' par exemple et de faire la meme chose jusqu'a 10 .

Cordialement

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 4 Avril 2006

• #4

bonsoir Vince

la boucle est loin d'etre optimisée , mais j'espere que cet exemple pourra t'aider

la procedure boucle sur tous les classeurs du repertoire 'C:\\\\\\\\Travaux\\\\\\\\' . Si le nom de feuille contient 01 , 02 , ...etc... , les données du classeur fermé sont importées dans un nouveau claseur Excel .
Remarque :
Le nouveau classeur ne doit pas etre sauvegardé dans le meme repertoire que les fichiers fermés .
Chaque fichier fermé ne doit contenir qu'une feuille .



'Necessite d'activer la reference Microsoft ActiveX Data object 2.x Library
'Necessite d'activer la reference Microsoft ADO Ext 2.7 for DLL And security
'
'le classeur contenant cette macro ne doit pas etre dans le meme repertoire que
'les classeurs fermés
Dim Fichier As String, Chemin As String, Cible As String
Dim Wb As Workbook
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Cat As ADOX.Catalog
Dim Feuille As ADOX.Table
Dim i As Byte

Chemin = 'C:\\\\\\\\Travaux\\\\\\\\' 'adapter le repertoire contenant les fichiers fermés
Fichier = Dir(Chemin & '*.xls')

On Error GoTo Fin

Application.ScreenUpdating = False
For i = 1 To 10 'boucle pour les 10 types de feuilles
Fichier = Dir(Chemin & '*.xls')
Set Wb = Workbooks.Add(1) 'creation d'un nouveau classeur pour importer les données

Do While Len(Fichier) › 0 'liste les fichiers du répertoire
Set Cn = New ADODB.Connection
Set Cat = New ADOX.Catalog
'connection fichier fermé
Cn.Open 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' & Chemin & Fichier & _
';Extended Properties=Excel 8.0;'
Set Cat.ActiveConnection = Cn

'on présume qu'il n'y a qu'une feuille dans les classeurs fermés
Set Feuille = Cat.Tables(0)
'verification si le nom de la feuille contient la valeur correcte ( 01 , 02 , ...etc...)
If Not InStr(1, Feuille.Name, CStr(Format(i, '00')), vbTextCompare) = 0 Then
Cible = 'SELECT * FROM [' & Feuille.Name & '];'

Set Rs = New ADODB.Recordset
Rs.Open Cible, Cn, adOpenStatic, adLockOptimistic, adCmdText

'copie des données du fichier fermé dans le nouveau classeur
If Not Rs.EOF Then ActiveSheet.Range('A1').CopyFromRecordset Rs
ActiveSheet.Name = Left(Fichier, Len(Fichier) - 4) 'renomme les feuilles dans le nouveau classeur
Wb.Sheets.Add after:=Wb.Worksheets(Wb.Worksheets.Count) 'ajout d'une nouvelle feuille

End If

Set Rs = Nothing
Cn.Close
Set Cn = Nothing
Set Cat = Nothing
Fichier = Dir()
Loop

If Not Wb.Sheets.Count = 1 Then
Application.DisplayAlerts = False
Wb.Sheets(Wb.Sheets.Count).Delete
Application.DisplayAlerts = True

'Attention à ne pas sauvegarder le classeur dans le repertoire contenant les fichiers fermés !
Wb.SaveAs 'C:\\\\\\\\Global ' & CStr(Format(i, '00')) & '.xls'
Wb.Close True
End If

Next i
Application.ScreenUpdating = True

Exit Sub
Fin:
Application.DisplayAlerts = True
MsgBox 'Operation annulée : ' & Err.Description


bonne soirée
MichelXld

Message édité par: michelxld, à: 05/04/2006 06:50

 

Vote positif 0 Vote négatif

V

vince

Guest

• 4 Avril 2006

• #5

Merci beaucoup de votre aide .

Mais comment fait on pouractiver la reference Microsoft ActiveX Data object 2.x Library
et la reference Microsoft ADO Ext 2.7 for DLL And security .

merci

 

Vote positif 0 Vote négatif

M

MichelXld

XLDnaute Barbatruc

• 4 Avril 2006

• #6

rebonsoir Vince

dans l'editeur de macros
Menu Outils
References
coches les 2 lignes
Microsoft ActiveX Data object 2.x Library
et
Microsoft ADO Ext 2.7 for DLL And security
Clique sur OK pour valider


bonne soirée
MichelXld

 

Vote positif 0 Vote négatif

V

vince

Guest

• 5 Avril 2006

• #7

merci de votre aide .

 

Vote positif 0 Vote négatif