Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauvegarder

[roidurif]

Bonjour,

La macro me permet d'ouvrir dans un repertoire les fichiers excel un à un, pour ensuite copier l'onglet et le sauvegarder dans un autre fichiers excel.

Sachant que j'ai plusieurs types de fichier excel à ouvrir ("*.xls", "*.xlsx", "*.xlsm"), je ne sais pas indiquer à la macro, d'ouvrir uniquement les fichiers ayant ces extentions "*.xls", "*.xlsx", "*.xlsm".

Merci de votre aide.

Sub Enregistrer_onglet()

Dim Chemin As String
Dim Fichier As String
Dim i As Long

Application.DisplayAlerts = False
Chemin = "C:\Traités\"
Fichier = Dir(Chemin & "*.xls", "*.xlsx", "*.xlsm")
Do While Fichier <> ""

For i = 1 To Sheets.Count
Workbooks.Open Filename:=Chemin & Fichier

Sheets("Tableau").Copy
TempFilePath = "C:\DATA\"
TempFileName = Workbooks(Fichier).Worksheets("Fiche").Range("F19") & "_" & Workbooks(Fichier).Worksheets("Fiche").Range("F7") & "_E_" & Format(Now, "yyyymmdd") & "_A_MAJ00_01"
FileExtStr = ".xlsx" '
ActiveWorkbook.SaveAs Filename:=TempFilePath & TempFileName & FileExtStr
ActiveWorkbook.Close

Workbooks(Fichier).Close SaveChanges:=False

Fichier = Dir
Next i
Loop
Application.DisplayAlerts = True
End Sub

 

[Pierrot93]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Bonjour,

A tout hasard, essaye peut être ainsi, si j'ai bien compris, non testé...

Fichier = Dir(Chemin & "*.xls*")

bonne fin d'après midi
@+

 

[roidurif]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Bonjour Pierrot93

Cela à l'air de fonctionné,

je te remercie d'avance

Fichier = Dir(Chemin & "*.xls*")

 

[C@thy]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Hello le fil, Pierrot,

j'ouvre un fichier .txt et je le transforme en colonnes (jusque làn tout va bien, merci l'enregistreur de macros...)
mais je veux le sauvegarder en : nom du fichier + .xlsx au lieu de .txt...
j'ai cherché avec left mais pas réussi...

Peut-être parmi vous y-a-t-il quelqu'un qui sait?

Un grand MERCI

C@thy

 

[camarchepas]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Bonjour C@thy,

En principe :

NomFichier = replace(NomFichier,".txt",".xlsx")

 

[C@thy]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Merci camarchepas mais...
ça marche pas! Il faut aussi enregistrer au format .xlsx et non pas juste changer l'extension.

C@thy

 

[camarchepas]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

C@thy,

J'ai pas bien décodé le besoin ,

comme ceci peut être alors :

NomFichier = Replace(NomFichier, ".txt", ".xlsx")
ActiveWorkbook.SaveAs Filename:="C:\temp\" & NomFichier, FileFormat:=xlWorkbookNormal, CreateBackup:=False

 

[job75]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Bonjour C@thy, hello camarchepas,

Le fichier .txt doit avoir été ouvert par Workbooks.Open et être le classeur actif.

Alors exécute ce code :

Dim chemin$
chemin = ThisWorkbook.Path & "\" 'à adapter
'----
With ActiveWorkbook
  If LCase(Right(.Name, 4)) = ".txt" Then 'sécurité
    Application.DisplayAlerts = False 'si le fichier .xlsx existe déjà
    .SaveAs chemin & Left(.Name, Len(.Name) - 4), 51 '51 => format .xlsx
    .Close 'facultatif
  End If
End With

A+

 

[C@thy]

Re : Macro : Ouvrir uniquement fichier "*.xls", "*.xlsx", "*.xlsm" puis copier/sauveg

Merci Gérard...

j'essayais de me faire discrète en réactivant un ancien post pour ne pas te déranger encore une fois...

Bises

C@thy