repartition de donnée

[humberto54]

Bonjour,
J’ai rencontré un problème lors de la création de mon programme,
J’ai un premier tableau ou ce trouve des données que je vais dispatcher dans plusieurs onglet, suivant les valeurs de la colonne « C », lors de l’extraction de la base de donnée ces valeurs ce nomment X05TR01170 pour FR1-EA par exemple. Dans le fichier repartir j’ai changé les noms manuellement, dans le second fichier j’ai créé une macro pour qu’il change automatiquement les noms, et la ma macro qui repartie les donnée ne fonctionne plus correctement je ne comprend pas pourquoi, pouvez-vous m’aider svp.

 

[gosselien]

Re : repartition de donnée

Bonjour,

pour "splitter" en onglet, tu peux essayer ceci et puis tu renommes

Sub SplitEnOnglets()
Dim rngdelete2 As Range
Dim rng2 As Range, Vides As Integer
Dim Le_parametre As Boolean
Dim LastrowC As Integer
Dim Titre, TotClass, TotGene, Colonne, mLong
Dim Zone
Application.ScreenUpdating = False
' nommer les colonnes
Application.DisplayAlerts = False
Range("A1").Select
Selection.CurrentRegion.Select
Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:=False
Application.DisplayAlerts = True
' tri sur la colonne choisie
LastrowC = Range("C65000").End(xlUp).Row
Colonne = Range("C:C").Column
mLong = IIf(Colonne <= 26, 4, 5)
Set Zone = Range("C2:C" & LastrowC)
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
With ActiveSheet
For Each rng2 In Zone
If rng2.Value = "" Then Vides = Vides + 1: GoTo Suivant ' rng2.Value = "SANS NOM"
Le_parametre = UCase(rng2.Value) = UCase(rng2.Offset(1, 0).Value)
If Not Le_parametre Then
If rngdelete2 Is Nothing Then
Set rngdelete2 = rng2.EntireRow
Else
Set rngdelete2 = Union(rngdelete2, rng2.EntireRow)
End If
Set Titre = Range("1:1")
Sheets.Add
ActiveWindow.Zoom = 110
Titre.Copy
Range("A1").PasteSpecial
ActiveSheet.Name = rng2.Value
If Not rngdelete2 Is Nothing Then
rngdelete2.EntireRow.Copy ActiveSheet.Range("A2")
TotClass = ActiveSheet.UsedRange.Rows.Count - 1 ' ne pas compter le titre
TotGene = TotGene + TotClass
Set rngdelete2 = Nothing
GoTo Suivant
End If
Else
If rngdelete2 Is Nothing Then
Set rngdelete2 = rng2.EntireRow
Else
Set rngdelete2 = Union(rngdelete2, rng2.EntireRow)
End If
End If
Suivant:
Next rng2
End With
End Sub


P.

 

[camarchepas]

Re : repartition de donnée

Bonjour Gosselien, Humberto ,

J'ai retesté le programme et il fonctionne très bien .

Qu'est qui ne fonctionne plus correctement ?

 

[humberto54]

Re : repartition de donnée

bonjour Camarchepas, dans le fichier programemag1 une fois que j'ai exécuté la macro changé de nom j'exécute la macro repartir et la une erreur s'affiche dans mon ma macro et il n'y a rien dans les onglet FR8_E?
Merci Gosselien je vais essayer de comprendre le programme que tu ma donner et je te dit si sa marche, mon expérience en VBA est de quelque semaine

 

[camarchepas]

Re : repartition de donnée

Re ,

Et oui , il manque l'onglet FR7-EA sur ton classeur .........

c'est pour cela que le traitement s'arrête

 

[humberto54]

Re : repartition de donnée

bonjour camarchepas aurait tu une idée pour effacer les ligne une fois que celle ci a était dispatché ?
actuellement j'ai créé une macro spécialement dédié a cela avec un bouton qui l'active mais c'est plus long

 

[camarchepas]

Re : repartition de donnée

Bonjour Humberto

Juste en fin de la macro Répartir tu ajoutes :

'Suppression des lignes
Range("A2:D" & LigneFin).Clear