Ouverture de plusieurs fichiers excel + enregistrement sous

Question

Bonjour 

J'ai crée une macro qui m'extrait des données via un site internet me les colles sur mon classeur excel actif (jusque ici tout va bien) les choses se compliquent lorsque je demande à excel de m'ouvrir plusieurs fichiers excel existant et de me les "enregistrer sous" dans un fichier que j'ai préalablement crée. 

Je vous colle mon code. 


Sub Test()
 
'EXTRACTION DONNEE du site web 


ActiveSheet.Calculate
Dim MonTexte As String
Sheets("Feuil1").Select
MonTexte = Range("O21")

Sheets(2).Select
With ActiveSheet.QueryTables.Add(Connection:= _
 MonTexte, _
 Destination:=Range("A1"))
 
 .BackgroundQuery = True
 .TablesOnlyFromHTML = True
 .Refresh BackgroundQuery:=False
 .SaveData = True
End With

 
'CREATION DES FICHIERS + ENREGISTREMENT DANS BON DOSSIER + OUVERTURE du doc 


Sheets("Feuil1").Select

Dim str As String
Dim dir As String
Dim hotelname As String
hotelname = Range("d10")
dir = "C:\Users\Arthur\Dropbox\Toptop" & hotelname & ""
Range("P12").Select
str = dir & ActiveCell.Text & ".xlsm"

'IMPORT WEB 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox\Toptop\standard\import_web_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
        
Windows("new_client.xlsm").Activate
    Sheets(1).Select

Range("P13").Select
str = dir & ActiveCell.Text & ".xlsm"

'Alib Les problèmes commencent ici ...

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\import_alib_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate
    Sheets(1).Select

Range("P14").Select
str = dir & ActiveCell.Text & ".xlsm"

'ALGO

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\algo_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate
    Sheets(1).Select

Range("P15").Select
str = dir & ActiveCell.Text & ".xlsm"

'SUMMARY RECO

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\summary recommendations_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate
    Sheets(1).Select

Range("P16").Select
str = dir & ActiveCell.Text & ".xlsm"

'LIVRABLE

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard
ouveau livrable standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate
    Sheets(1).Select

Range("P17").Select
str = dir & ActiveCell.Text & ".xlsm"

'IMPORT RESA

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\import_topsys2.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate
    Sheets(1).Select

Range("P18").Select
str = dir & ActiveCell.Text & ".xlsm"

'CHEMIN RESA

Workbooks.Open ("C:\Users\Arthur\Dropbox	optop\standard\chemin_resa_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
'FIN CREATION FICHIERS

NHenry · Answer

Bonjour, 

Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, celui-ci pour bien poser votre question ou encore celui-ci pour les PFE et autres exercices.[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).[*]En VB.NET pensez à activer Option Explicit et Option Strict (propriété du projet) et à retirer l'import automatique de l'espace de nom Microsoft.VisualBasic (onglet Références dans les propriétés du projet).[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés/list
---
Mon site

azeite4 · Answer

Bonjour 

J'ai crée une macro qui m'extrait des données via un site internet me les colles sur mon classeur excel actif (jusque ici tout va bien) les choses se compliquent lorsque je demande à excel de m'ouvrir plusieurs fichiers excel existant et de me les "enregistrer sous" dans un fichier que j'ai préalablement crée. 

Je vous colle mon code. 


Sub Test() 

'EXTRACTION DONNEE du site web 


ActiveSheet.Calculate 
Dim MonTexte As String 
Sheets("Feuil1").Select 
MonTexte = Range("O21") 

Sheets(2).Select 
With ActiveSheet.QueryTables.Add(Connection:= _ 
MonTexte, _ 
Destination:=Range("A1")) 

.BackgroundQuery = True 
.TablesOnlyFromHTML = True 
.Refresh BackgroundQuery:=False 
.SaveData = True 
End With 


'CREATION DES FICHIERS + ENREGISTREMENT DANS BON DOSSIER + OUVERTURE du doc 


Sheets("Feuil1").Select 

Dim str As String 
Dim dir As String 
Dim hotelname As String 
hotelname = Range("d10") 
dir = "C:\Users\Arthur\Dropbox\Toptop" & hotelname & "" 
Range("P12").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'IMPORT WEB 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox\Toptop\standard\import_web_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate 
Sheets(1).Select 

Range("P13").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'Alib Les problèmes commencent ici ... 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\import_alib_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate 
Sheets(1).Select 

Range("P14").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'ALGO 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\algo_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate 
Sheets(1).Select 

Range("P15").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'SUMMARY RECO 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\summary recommendations_standard.xlsm") 
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate 
Sheets(1).Select 

Range("P16").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'LIVRABLE 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard
ouveau livrable standard.xlsm") 
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate 
Sheets(1).Select 

Range("P17").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'IMPORT RESA 

Workbooks.Open Filename:=("C:\Users\Arthur\Dropbox	optop\standard\import_topsys2.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Windows("new_client.xlsm").Activate 
Sheets(1).Select 

Range("P18").Select 
str = dir & ActiveCell.Text & ".xlsm" 

'CHEMIN RESA 

Workbooks.Open ("C:\Users\Arthur\Dropbox	optop\standard\chemin_resa_standard.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _ 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'FIN CREATION FICHIERS

bigfish_le vrai · Answer

Salut,

et... on reste une peu sur notre faim la ! c'est quoi qui se complique lorsque tu demandes à excel d' ouvrir plusieurs fichiers etc ???

A+

azeite4 · Answer

Hello 

Merci pour ta réponse bigfish. Le probleme c'était que mes fichiers ne voulaient pas s'ouvrir lorsque je lancais la macro, mais j'ai finalement pu le résoudre hier soir! Mon code était bon , mais le chemin que j'avais indiqué était faux... du coup ca aide pas! 

Au passage j'aurais une autre question, toujours en rapport avec ce code. Une fois que mes fichiers se seront ouvert et "enregister sous", j'aimerai qu'ils se referment. 

Pour qu'ils se referment j'ai utilisé la code ci dessous

En precisant que toto est une variable.. mais quand j'execute le code ca ne fonctionne pas :s 

[color=blue]Windows(toto).Activate
    ActiveWorkbook.Close SaveChanges:=False
/color
Sheets("Feuil1").Select

Dim str As String
Dim dir As String
Dim hotelname As String
Dim toto As String

hotelname = Range("d10")
dir = "C:\Users\Arthur\Dropbox	optop" & hotelname & ""

Range("n12").Select
str = dir & ActiveCell.Text & ".xlsm"
toto = ActiveCell.Text & ".xlsm"

'IMPORT WEB

Application.Workbooks.Open ("C:\Users\Arthur\Dropbox	optop\standard\import_web.xlsm")
ActiveWorkbook.SaveAs Filename:=str, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
Windows(toto).Activate
    ActiveWorkbook.Close SaveChanges:=False

Ouverture de plusieurs fichiers excel + enregistrement sous

4 réponses

Votre réponse

Discussions similaires