reduction de macro boucle pour x fichier

[gabmail]

bonjour a vous

je cherche a regroupé x page internet en un tableau excel
vu que les pages internets non pas forcement la meme mise en forme
jutilise un classeur intermédiaire pour reclasser les infos
enfin voila ma macro de mise en page

Sub Macroa0CopiDeTrameàReduit()


'Copi Temp0zjoueur (aaaa) cole sur 0zTrameJoueur (aaaa).xls

Windows("Temp0zjoueur (aaaa)").Activate
Cells.Select
Selection.Copy
Windows("0zTrameJoueur (aaaa).xls").Activate
Sheets("Collage").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Windows("Temp0zjoueur (aaaa)").Activate
ActiveWindow.Close
' Copi de 0zJoueur (1).xls sur "0yRegroupe.xls"
Windows("0zTrameJoueur (aaaa).xls").Activate
Sheets("InfoJouer").Select ' "InfoJouer"
Range("A2:O11").Select
Selection.Copy
Windows("0yRegroupe.xls").Activate
Sheets("InfoJouer").Select
Cells(65535, 1).End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("0zTrameJoueur (aaaa).xls").Activate ' "SaisonActuel"
Sheets("SaisonActuel").Select
Range("A2:O11").Select
Selection.Copy
Windows("0yRegroupe.xls").Activate
Sheets("SaisonActuel").Select
Cells(65535, 1).End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Windows("0zTrameJoueur (aaaa).xls").Activate ' "Carrière"
Sheets("Carrière").Select
Range("A2:O41").Select
Selection.Copy
Windows("0yRegroupe.xls").Activate
Sheets("Carrière").Select
Cells(65535, 1).End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

End Sub

Voici le debut de ma 2eme macro qui se reproduit avec comme seul changement le passage de joueur (0001) jusqu a joueur (9999)
realisé avec des copi collé

Workbooks.Open Filename:="C:\foot\Joueur\0zTrameJoueur (aaaa).xls" ' joueur (1).html
Workbooks.Open Filename:="C:\foot\Joueur\Aspi\Joueur0a50000\Joueur0a50000\lfp.fr\joueur\joueur (1).html"
Windows("joueur (1).html").Activate
ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\Temp0zjoueur (aaaa).xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.Run "'0xMacroRegroupeJoueur0a50000.xls'!Macroa0CopiDeTrameàReduit"
Windows("0zTrameJoueur (aaaa).xls").Activate
ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\0zjoueur (0001).xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Workbooks.Open Filename:="C:\foot\Joueur\0zTrameJoueur (aaaa).xls" ' joueur (2).html
Workbooks.Open Filename:="C:\foot\Joueur\Aspi\Joueur0a50000\Joueur0a50000\lfp.fr\joueur\joueur (2).html"
Windows("joueur (2).html").Activate
ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\Temp0zjoueur (aaaa).xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
Application.Run "'0xMacroRegroupeJoueur0a50000.xls'!Macroa0CopiDeTrameàReduit"
Windows("0zTrameJoueur (aaaa).xls").Activate
ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\0zjoueur (0002).xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close



cette 2eme macro devrai pouvoir se reduir a une boucle simple
du type
tu ouvre le premier fichier du repertoir
tu execute la macro mise en forme
tu ferme le fichier et tu passe au suivant ainsi de suite

tous les fichier sont sous la forme Joueurs (xxxx) et dans un repertoir consacré

merci a vous

 

[skoobi]

Re : reduction de macro boucle pour x fichier

Bonjour gabmail,

voici un code à tester:

Sub test()
  For joueur = 1 To 9999
    Workbooks.Open Filename:="C:\foot\Joueur\0zTrameJoueur (aaaa).xls"  ' joueur (1).html
    Workbooks.Open Filename:="C:\foot\Joueur\Aspi\Joueur0a50000\Joueu r0a50000\lfp.fr\joueur\joueur (" & joueur & ").html"
    Windows("joueur (" & joueur & ").html").Activate
    ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\T emp0zjoueur (aaaa).xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Application.Run "'0xMacroRegroupeJoueur0a50000.xls'!Macroa0CopiDeT rameàReduit"
    Windows("0zTrameJoueur (aaaa).xls").Activate
    Num = Format(joueur, "0000")
    ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\0 zjoueur (" & Num & ").xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
  Next
End Sub

 

[gabmail]

Re : reduction de macro boucle pour x fichier

trop cool merci a toi
je pige pas du tout se que sa fait se qui me pose un gros prob
mais mon clavier et control c et v te remerci
encore merci

ps en abusant de ton temps si tu pouvais me faire une explication de text

 

[skoobi]

Re : reduction de macro boucle pour x fichier

Re bonjour,

Et bien j'ai simplement créé un boucle: For joueur = 1 To 9999 ........ Next
(pour joueur = 1 à 9999) pour pouvoir traiter tous les fichiers (en bleu ce que j'ai fais:

Sub test()
[COLOR=Blue][B]  For joueur = 1 To 9999[/B][/COLOR]
    Workbooks.Open Filename:="C:\foot\Joueur\0zTrameJoueur (aaaa).xls"  ' joueur (1).html
    Workbooks.Open Filename:="C:\foot\Joueur\Aspi\Joueur0a50000\Joueu r0a50000\lfp.fr\joueur\joueur ([COLOR=Blue][B]" & joueur & "[/B][/COLOR]).html"
    Windows("joueur ([B][COLOR=Blue]" & joueur & "[/COLOR][/B]).html").Activate
    ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\T emp0zjoueur (aaaa).xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Application.Run "'0xMacroRegroupeJoueur0a50000.xls'!Macroa0CopiDeT rameàReduit"
    Windows("0zTrameJoueur (aaaa).xls").Activate
    [COLOR=Blue][B]Num = Format(joueur, "0000")[/B][/COLOR]
    ActiveWorkbook.SaveAs Filename:="C:\foot\Joueur\AspiCopi\Joueur0a50000\0 zjoueur ([B][COLOR=Blue]" & Num & "[/COLOR][/B]).xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
 [COLOR=Blue][B] Next[/B][/COLOR]

End Sub