Découpage fichier excel plusieurs onglets selon code alpha et numerique

Sand2207

XLDnaute Nouveau
Bonjour,

Je découpe mon fichier de primes tous les trimestres en
- zones (groupement de régions) nommées "DZ + chiffre"
- région (groupement de secteurs) nommées "W00 + chiffre" ou "W00 + lettre" à compter de la région 10

Aujourd'hui je dois découper mon fichier en secteurs.
Les secteurs sont nommées de la manière suivante :
- W + chiffre ou lettre de la région + chiffre ou lettre à compter du dixième secteur de la région.
Soit par exemple :
- région 1 secteur 3 = W13
- région 1 secteur 12 = W1C
- région 10 secteur 3 = WA3

Mon fichier comporte plusieurs onglets.
J'ai harmonisé mon fichier pour que la plage de découpe commence à partir de la ligne 6.
En cas de décalage quelconque de lignes dans les onglets de mon fichier, je n'ai pas souhaité dans mes macros de découpage par zone ou région m'appuyer sur le nombre de lignes du fichier Excel mais bien sur les codes des zones ou régions.
En effet, parfois sur la même campagne de primes je travaille sur 2 sectorisations (donc secteurs ajoutés ou supprimés selon les onglets du fichier)

Voici la tentative d'adaptation de l'une de mes macros de découpage :
Sub SplitSecteur()
Dim NbRegion As String
Dim NbSecteur As String
Dim Compteur1 As Byte
Dim Compteur2 As Byte
Dim FeuilleTestee As Worksheet
Dim Nblignes As Long
Dim NomSecteur() As String
Dim NomRegion() As String
Dim Alphabet()
Dim DerniereLigne As Long
Do
NbRegion = InputBox("Veuillez saisir le nombre de régions", "Nombre de région", 15)
NbSecteur = InputBox("Veuillez saisir le nombre maximum de secteurs par région", "Nombre de max secteurs/région", 10)
Loop Until IsNumeric(NbRegion) = True
'Redimensionnement de la variable tableau ac le nombre de région obtenues
ReDim NomRegion(NbRegion)
Alphabet = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
For Compteur1 = 1 To NbRegion
If Compteur1 <= 9 Then
NomRegion(Compteur1) = "W" & Compteur1
Else
NomRegion(Compteur1) = "W" & Alphabet(Compteur1 - 9)
End If
Next
For Compteur2 = 1 To NbSecteur
If Compteur2 <= 9 Then
NomSecteur(Compteur2) = NomRegion(Compteur1) & Compteur2
Else
NomSecteur(Compteur2) = NomRegion(Compteur1) & Alphabet(Compteur2 - 9)
End If
Next
For Compteur = 1 To NbSecteur * NbRegion
Sheets(Array("Grilles primes", "Synthèse", "RO Top", "RO Others", "Dvpt CA", "Challenge", "aaa")).Copy
ActiveWorkbook.SaveAs "H:\Entreprise SAS\......\ENT._Primes 2014 T1_DMP_" & NomSecteur(Compteur2) & ".xlsx"
For Each FeuilleTestee In ActiveWorkbook.Worksheets
If FeuilleTestee.Name <> "Informations" And FeuilleTestee.Name <> "Grilles primes" Then
FeuilleTestee.Select
'Copie-colle en valeur
Cells.Copy
Cells.PasteSpecial xlPasteValues
Range("d6").Select
DerniereLigne = Range("d6").End(xlDown).Row
'Suppresion des lignes de totaux, infos en dessous du tableau
Rows(DerniereLigne + 2 & ":165").Delete
'Pour éviter d'oublier certaines lignes lors de la suppression de ces lignes, on utilise tjrs la boucle For en sens inverse (de la dernière ligne à la première)
For Nblignes = DerniereLigne To 6 Step -1
If Range("d" & Nblignes).Value <> NomRegion(Compteur) Then
Rows(Nblignes).Delete
End If
Next
End If
Next
'Enregistrement du fichier
Sheets("Synthèse").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks("ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm").Activate
Next
ActiveWorkbook.Close False
End Sub

J'ai un bug à la ligne : NomSecteur(Compteur2) = NomRegion(Compteur1) & Compteur2

Pourriez-vous m'aider ?

Merci beaucoup

Sand
 

Pièces jointes

  • ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm
    97.2 KB · Affichages: 33
  • ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm
    97.2 KB · Affichages: 38
  • ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm
    97.2 KB · Affichages: 41

Staple1600

XLDnaute Barbatruc
Re : Découpage fichier excel plusieurs onglets selon code alpha et numerique

Bonsoir à tous

Sandrine D.
Remplaces ou ajoutes les lignes suivantes dans ton code original et testes ce qui se passe
Code:
Dim NbRegion& 'As String
Dim NbSecteur& 'As String

'Redimensionnement de la variable tableau ac le nombre de région obtenues
ReDim NomRegion(NbRegion)
ReDim NomSecteur(NbSecteur)


For Compteur2 = 1 To NbSecteur
    If Compteur2 <= 9 Then
        NomSecteur(Compteur2) = NomRegion(Compteur1 - 1) & Compteur2
    Else
        NomSecteur(Compteur2) = NomRegion(Compteur1 - 1) & Alphabet(Compteur2 - 9)
    End If
Next
 

Sand2207

XLDnaute Nouveau
Re : Découpage fichier excel plusieurs onglets selon code alpha et numerique

Bonjour Staple1600,

Merci de ton aide, je n'ai plus le bug sur la ligne du nom de secteur mais dans le code qui suit j'ai maintenant la macro qui boucle sur le même code secteur.
En effet, elle me propose d'enregistrer toujours le même nom de fichier sur lui même, c'est moche :)

Sub SplitSecteur()
Dim NbRegion As String
Dim NbSecteur As String
Dim Compteur1 As Byte
Dim Compteur2 As Byte
Dim FeuilleTestee As Worksheet
Dim Nblignes As Long
Dim NomSecteur() As String
Dim NomRegion() As String
Dim Alphabet()
Dim DerniereLigne As Long

Do
NbRegion = InputBox("Veuillez saisir le nombre de régions", "Nombre de région", 15)
NbSecteur = InputBox("Veuillez saisir le nombre maximum de secteurs par région", "Nombre de max secteurs/région", 10)
Loop Until IsNumeric(NbRegion) = True
'Redimensionnement de la variable tableau ac le nombre de région obtenues
ReDim NomRegion(NbRegion)
ReDim NomSecteur(NbSecteur)
Alphabet = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
For Compteur1 = 1 To NbRegion
If Compteur1 <= 9 Then
NomRegion(Compteur1) = "W" & Compteur1
Else
NomRegion(Compteur1) = "W" & Alphabet(Compteur1 - 9)
End If
Next
For Compteur2 = 1 To NbSecteur
If Compteur2 <= 9 Then
NomSecteur(Compteur2) = NomRegion(Compteur1 - 1) & Compteur2
Else
NomSecteur(Compteur2) = NomRegion(Compteur1 - 1) & Alphabet(Compteur2 - 9)
End If
For Compteur = 1 To NbSecteur * NbRegion
Sheets(Array("Grilles primes", "Synthèse", "RO Top", "RO Others", "Dvpt CA", "Challenge", "aaa")).Copy
ActiveWorkbook.SaveAs "H:\Entreprise SAS\......\ENT._Primes 2014 T1_DMP_" & NomSecteur(Compteur2) & ".xlsx"
For Each FeuilleTestee In ActiveWorkbook.Worksheets
If FeuilleTestee.Name <> "Informations" And FeuilleTestee.Name <> "Grilles primes" Then
FeuilleTestee.Select
'Copie-colle en valeur
Cells.Copy
Cells.PasteSpecial xlPasteValues
Range("d6").Select
DerniereLigne = Range("d6").End(xlDown).Row
'Suppresion des lignes de totaux, infos en dessous du tableau
Rows(DerniereLigne + 2 & ":165").Delete
'Pour éviter d'oublier certaines lignes lors de la suppression de ces lignes, on utilise tjrs la boucle For en sens inverse (de la dernière ligne à la première)
For Nblignes = DerniereLigne To 6 Step -1
If Range("d" & Nblignes).Value <> NomRegion(Compteur) Then
Rows(Nblignes).Delete
End If
Next
End If
Next
Next
'Enregistrement du fichier
Sheets("Synthèse").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks("ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm").Activate
Next
ActiveWorkbook.Close False
End Sub

Pourrais-tu de nouveau jeter un coup d'oeil ?

Merci beaucoup

Sand
 

mutzik

XLDnaute Barbatruc
Re : Découpage fichier excel plusieurs onglets selon code alpha et numerique

bonjour,

je crois que la première des choses est de bien structurer les données que tu utilises en enlevant le superflu
j'ai un peu modifié ton fichier en n'y laissant que les données utiles
A partir de là, les éventuelles macros s'en trouveront allégées, et le code plus facilement compréhensible si tu dois y revenir un jour prochain
 

Pièces jointes

  • ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm
    90.6 KB · Affichages: 31
  • ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm
    90.6 KB · Affichages: 35
  • ENT._PRIMES_2014 T1_DMP Metropole VF.xlsm
    90.6 KB · Affichages: 36

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 846
dernier inscrit
Silhabib