Découpage fichier en régions

[Sand2207]

Bonjour à tous,

Aïe, j'ai bien essayé de me tripatouiller une macro en fonction de différentes réponses sur le forum mais là je coince ... ...

J'ai un fichier de travail national à découper en x régions.
Pour cela je suis passée la logique suivante
1 -création de x onglets "source" (une macro sur laquelle je n'ai pas eu de soucis)
2 -couper l'onglet x1 et le transférer dans un nouveau fichier + transférer les onglets dépendants de la source pour que les tableaux et graphes pointent uniquement vers les données de la région.

Pour une région j'y suis arrivée, mais j'en ai une vingtaine à faire ...
Comment faire en sorte de ne pas recopier et modifier 20 fois le code établi pour une région ?

Pouvez-vous m'aider ?

Merci beaucoup

Sandrine
Ci-dessous ma macro si mon explication en "mots" n'a pas été claire, toutes mes excuses si elle n'est pas parfaite, j'ai "cuisiné" mais ça marche (pour la région 5 !!!)

Sub SplitRegion()
Sheets("RÉGION 05").Select
Sheets("RÉGION 05").Move
Sheets("RÉGION 05").Select
Sheets("RÉGION 05").Name = "Data région"
Range("A1").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\Sand\PDM_Region 05.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Colors(25) = RGB(0, 0, 0)
ActiveWorkbook.Colors(26) = RGB(0, 0, 153)
ActiveWorkbook.Colors(27) = RGB(153, 204, 0)
ActiveWorkbook.Colors(28) = RGB(255, 51, 204)
ActiveWorkbook.Colors(29) = RGB(255, 0, 0)
ActiveWorkbook.Colors(30) = RGB(153, 102, 51)
ActiveWorkbook.Colors(31) = RGB(128, 0, 128)
ActiveWorkbook.Colors(32) = RGB(0, 0, 255)
ActiveWorkbook.Colors(33) = RGB(255, 102, 0)
ActiveWorkbook.Colors(34) = RGB(0, 255, 0)
ActiveWorkbook.Colors(35) = RGB(255, 153, 255)
ActiveWorkbook.Colors(36) = RGB(255, 80, 80)
ActiveWorkbook.Colors(37) = RGB(255, 255, 0)
ActiveWorkbook.Colors(38) = RGB(153, 0, 255)
ActiveWorkbook.Colors(39) = RGB(204, 236, 255)
ActiveWorkbook.Colors(40) = RGB(51, 204, 255)
Windows("PDM 2010 01.xls").Activate
Sheets(Array("CA France Mois", "Graphique CA", "PDM CA", "Graphique PDMCA", "ECART" _
, "Graphique Ecart", "CA France CMA")).Select
Sheets("CA France Mois").Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("CA France Mois", "Graphique CA", "PDM CA", "Graphique PDMCA", "ECART" _
, "Graphique Ecart", "CA France CMA", "Graphique CA France CMA", _
"Graphique PMCA France CMA")).Select
Sheets(Array("CA France Mois", "Graphique CA", "PDM CA", "Graphique PDMCA", "ECART" _
, "Graphique Ecart", "CA France CMA", "Graphique CA France CMA", _
"Graphique PMCA France CMA")).Copy after:=Workbooks( _
"PDM_Region 05.xls").Sheets("Data région")
ActiveWindow.SmallScroll Down:=-3
Sheets("CA France Mois").Select
Application.WindowState = xlMinimized
ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
"'Data région'!R1C1:R121C19"
ActiveWorkbook.ShowPivotTableFieldList = False
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache.Refresh
Sheets("PDM CA").Select
Application.WindowState = xlMinimized
ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
"'Data région'!R1C1:R121C19"
ActiveWorkbook.ShowPivotTableFieldList = False
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
Sheets("ECART").Select
Application.WindowState = xlMinimized
ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
"'Data région'!R1C1:R121C19"
ActiveWorkbook.ShowPivotTableFieldList = False
ActiveSheet.PivotTables("TCD écart").PivotCache.Refresh
Sheets(Array("Data région", "CA France Mois", "PDM CA", "ECART", "CA France CMA") _
).Select
Sheets("Data région").Activate
ActiveWindow.SelectedSheets.Visible = False
ActiveWorkbook.Save
Windows("PDM.xls").Activate
End Sub

 

[kjin]

Re : Découpage fichier en régions

Bonsoir,
[thread=32841]charte du forum[/thread]
Je ne voudrais pas paraitre désagréable, mais penses-tu avoir une chance obtenir une réponse pertinente avec juste ce bout de code sorti de son contexte et sans fichier ?!
A+
kjin

 

[Sand2207]

Re : Découpage fichier en régions

Bonjour,

Oui je pensais qu'il était suffisant de mettre le code en entier et donc qu'il n'était pas nécessaire dans ce cas là de mettre mon fichier puisque je n'avais plus besoin d 'intervenir dessus, juste d'avoir une astuce pour ne pas recopier x fois mon code.

Merci de votre lecture de ma problématique, je clos ma demande d'aide.

Bonne journée à toutes et tous

Sandrine

 

[kjin]

Re : Découpage fichier en régions

Bonjour,
Un code sorti de son contexte ne veut souvent pas dire grand chose pour le lecteur qui lui ne dispose pas du fichier correspondant ou au minimum de sa structure...
A+
kjin

 

[Efgé]

Re : Découpage fichier en régions

Bonjour Sand2207, kjin,
Sans aucune certitude et admettant que les feuilees sont région 1, région 2 et pas région 01:

Sub SplitRegion()
For i = 1 to 20
Sheets("RÉGION " & i).Select
Sheets("RÉGION " & i).Move
Sheets("RÉGION " & i).Select
Sheets("RÉGION " & i).Name = "Data région"
'Etc....
 
'Etc....
Next i
End Sub

Cordialement

 

[Efgé]

Re : Découpage fichier en régions

Re
Ou peut être, sans tenir compte du nom des feuilles:

Dim F As Worksheet
For Each F In ThisWorkbook.Worksheets
F.Select
F.[COLOR=red][B]Copy[/B][/COLOR]
F.Name = "Data région"
Etc...
 
Etc...
Next
End Sub

Si vous effectuez un Move de toutes les feuilles, il y aura un plantage à la dernière..
Cordialement