Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

A

aldo

XLDnaute Nouveau
Bonjour à toutes et tous, forum,

j'aimerai assez pouvoir ventiler automatiquement un fichier composé de 3 onglets en fonction des diffférentes premières lettres d'une colonne (la même dans les différents onglets.

J'ai cherché ici mais je n'ai pas trouvé mon bonheur (ou alors je ne l'ai pas compris...)

je dois faire cette opération au moins une fois par semaine et le fichier est assez important:
colonnes de A à BA
onglet 1 : environ 9000 lignes
onglet 2 : environ 4000 lignes
onglet 3 : environ 10000 lignes

le but étant de respecter la composition avec les 3 onglets pour chaque fichier créé suivant la première lettres de la colonne G.
Cette colonne est composée de noms de départements qui peuvent être de 1 à 7 ou 8 lettres plus des chiffres et des ? et des / et des -... il y a de tout en fait. c'est pour ça que je ne me préoccupe que de la première lettre (pour l'instant j'ai 15 premières lettres différentes.

est-ce que je suis assez clair ?

Je joins un exemple (Copy.xls) avec des données factices pour illustrer mon propos :
il y a trois onglets : R, D et C
et un autre fichier (but-Y.xls) avec le but à atteindre (ici, l'exemple de tout ce qui commence par "Y" dans la colonne G)

merci de m'avoir lu et d'essayer de m'aider.

Bonne journée.
 

Pièces jointes

  • but-Y.xls
    17 KB · Affichages: 74
  • Copy.xls
    27 KB · Affichages: 76
Trier par date Trier par votes
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Bonjour,

quelques précisions...

- les noms de tes trois onglets sont bien R, D et C dans ton fichier réel?

- les onglets d'extraction sont indépendants en fonction des noms des trois onglets principaux (onglet R, créér des onglets R_Département, onglet D, créér des onglets D_Département...) ou il faut mettre tous les départements dans un même onglet (onglet Département, toutes les données des onglets R, D et C)?
 
Vote positif 0 Vote négatif
A

aldo

XLDnaute Nouveau
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Bonjour,

- R, D et C peuvent être les noms ce n'est pas important pour moi mais pour répondre exactement à la question, les onglets sont en réalité RELEASED, DRAFT et CLOSED.

- ils doivent être comme mentionné ci-dessus pour chaque fichier créé pour chaque département:
- fichier A avec les onglets RELEASED, DRAFT et CLOSED
- fichier B avec les onglets RELEASED, DRAFT et CLOSED
- fichier C avec les onglets RELEASED, DRAFT et CLOSED
- etc...

Merci beaucoup !

aldo
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Re-,

un premier jet, de ce que j'ai compris..

Attention, dans ton fichier réel, il ne faut que les 3 onglets que tu as dans ton fichier exemple, sinon il va falloir adapter le code..

Pour un essai, enregistre le fichier que je te joins dans un nouveau répertoire, et clique sur le petit rectangle jaune, dans la cellule A1 du premier onglet.

Dans ce répertoire, il va se créér 30 fichiers...

ça prend à peu près 12 secondes, pour ton exemple, donc dans ton fichier réel, c'est possible que ça prenne un peu plus de temps (surtout en fonction du nombre de départements)

Teste, et dis quoi....
 

Pièces jointes

  • aldo_v1.zip
    15.6 KB · Affichages: 27
Vote positif 0 Vote négatif
A

aldo

XLDnaute Nouveau
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Re,

merci bhbh !

Oui j'ai besoin qu'ils aient tous la même "forme" parcequ'après je les traite avec une macro de mise en forme que j'ai fait et qui fonctionne (truc incroyable !!) et ensuite j'envoie tout ça à chaque personne dédiée pour chaque département, donc dans un soucis d'équité, il faut que tout le monde reçoive la même chose.
désolé..:rolleyes:

aldo
 
Vote positif 0 Vote négatif
mromain

mromain

XLDnaute Barbatruc
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

bonjour aldo, bhbh

voici un essai :
Code: 
Public Sub test()
Application.ScreenUpdating = False
Dim listeDepartement() As String, i As Integer, j As Integer, wbk As Workbook, curSheet As Worksheet
listeDepartement = RecupListeDepartements
For i = LBound(listeDepartement) To UBound(listeDepartement)
    Set wbk = Application.Workbooks.Add(xlWBATWorksheet)
    For Each curSheet In ThisWorkbook.Worksheets
        wbk.Sheets.Add after:=wbk.Sheets(wbk.Sheets.Count)
        With wbk.Sheets(wbk.Sheets.Count)
            .Name = curSheet.Name
            curSheet.Rows(1).Copy .Range("A1")
            For j = 2 To curSheet.Range("G" & curSheet.Rows.Count).End(xlUp).Row
                If curSheet.Range("G" & j).Text = listeDepartement(i) Then
                    curSheet.Rows(j).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
                End If
            Next j
        End With
    Next curSheet
    Application.DisplayAlerts = False: wbk.Sheets(1).Delete: Application.DisplayAlerts = True
    wbk.SaveAs (ThisWorkbook.Path & "\" & Replace(listeDepartement(i), "/", ""))
    wbk.Close False
Next i
Application.ScreenUpdating = True
End Sub


Private Function RecupListeDepartements() As String()
Dim curSheet As Worksheet, tableauDepartements() As String, i As Integer, compteurTableau As Integer
ReDim tableauDepartements(1 To 1)
For Each curSheet In ThisWorkbook.Worksheets
    For i = 2 To curSheet.Range("G" & curSheet.Rows.Count).End(xlUp).Row
        If Not verifDejaSaisi(tableauDepartements, curSheet.Range("G" & i).Text) Then
            compteurTableau = compteurTableau + 1
            ReDim Preserve tableauDepartements(1 To compteurTableau)
            tableauDepartements(UBound(tableauDepartements)) = curSheet.Range("G" & i).Text
        End If
    Next i
Next curSheet
RecupListeDepartements = tableauDepartements
End Function

Private Function verifDejaSaisi(tableau() As String, valeur As String) As Boolean
Dim i As Integer
verifDejaSaisi = False
For i = LBound(tableau) To UBound(tableau)
    If tableau(i) = valeur Then verifDejaSaisi = True: Exit Function
Next i
End Function

cette macro est à lancer depuis ton classeur "à éclater".
par contre, elle différenciera un département "YY" d'un autre "YYY" (elle créera 2 fichier)

a+
 
Vote positif 0 Vote négatif
A

aldo

XLDnaute Nouveau
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Re,

et bien ça marche super, sauf que c'est l'inverse au niveau ventilation. Désolé je n'ai pas été assez clair. Je recommence mais par la fin:
dans le dossier final, j'aimerai avoir:
- un fichier A.xls composé des onglets RELEASED, DRAFT et CLOSED pour les lignes dont les départements commencent par "A"
- un fichier B.xls composé des onglets RELEASED, DRAFT et CLOSED pour les lignes dont les départements commencent par "B"
- un fichier C.xls composé des onglets RELEASED, DRAFT et CLOSED pour les lignes dont les départements commencent par "C"
- etc...

mais merci bien, je le garde ce fichier parceque ça peut quand même me servir.

PS : je ne l'avais pas dit dans mon premier post mais la version que j'utilise est Excel 2000 en anglais.

aldo
 
Vote positif 0 Vote négatif
A

aldo

XLDnaute Nouveau
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Bonjour mromain,

merci beaucoup mais ta macro est TROP performante, trop précise en fait, puisque là je vais avoir 1000 fichiers différents...au moins...

aldo
 
Vote positif 0 Vote négatif
mromain

mromain

XLDnaute Barbatruc
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

re,

un autre essai (où on vérifie que la première lettre des départements)
Code: 
Public Sub test()
Application.ScreenUpdating = False
Dim listeDepartement() As String, i As Integer, j As Integer, wbk As Workbook, curSheet As Worksheet
listeDepartement = RecupListeDepartements
For i = LBound(listeDepartement) To UBound(listeDepartement)
    Set wbk = Application.Workbooks.Add(xlWBATWorksheet)
    For Each curSheet In ThisWorkbook.Worksheets
        wbk.Sheets.Add after:=wbk.Sheets(wbk.Sheets.Count)
        With wbk.Sheets(wbk.Sheets.Count)
            .Name = curSheet.Name
            curSheet.Rows(1).Copy .Range("A1")
            For j = 2 To curSheet.Range("G" & curSheet.Rows.Count).End(xlUp).Row
                If curSheet.Range("G" & j).Text Like listeDepartement(i) & "*" Then
                    curSheet.Rows(j).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
                End If
            Next j
        End With
    Next curSheet
    Application.DisplayAlerts = False: wbk.Sheets(1).Delete: Application.DisplayAlerts = True
    wbk.SaveAs (ThisWorkbook.Path & "\" & listeDepartement(i))
    wbk.Close False
Next i
Application.ScreenUpdating = True
End Sub


Private Function RecupListeDepartements() As String()
Dim curSheet As Worksheet, tableauDepartements() As String, i As Integer, compteurTableau As Integer
ReDim tableauDepartements(1 To 1)
For Each curSheet In ThisWorkbook.Worksheets
    For i = 2 To curSheet.Range("G" & curSheet.Rows.Count).End(xlUp).Row
        If Not verifDejaSaisi(tableauDepartements, Left(curSheet.Range("G" & i).Text, [COLOR=Red][B]1[/B][/COLOR])) Then
            compteurTableau = compteurTableau + 1
            ReDim Preserve tableauDepartements(1 To compteurTableau)
            tableauDepartements(UBound(tableauDepartements)) = Left(curSheet.Range("G" & i).Text, [B][COLOR=Red]1[/COLOR][/B])
        End If
    Next i
Next curSheet
RecupListeDepartements = tableauDepartements
End Function

Private Function verifDejaSaisi(tableau() As String, valeur As String) As Boolean
Dim i As Integer
verifDejaSaisi = False
For i = LBound(tableau) To UBound(tableau)
    If tableau(i) = valeur Then verifDejaSaisi = True: Exit Function
Next i
End Function
pour tester plus d'une lettre (les 3 premières par exemple), remplacer les deux "1" de la fonction "RecupListeDepartements" par "3".

a+
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Ventiler 3 onglets en X fois 3 onglets suivant 1ère lettre d'une colonne

Re-,

@ mromain :):)

avec le fichier exemple d'aldo, ton code faisait 6 secondes, le mien un peu plus de 10...

Pour essais, j'ai créé un fichier avec les données d'aldo :

onglet 1 : environ 9000 lignes
onglet 2 : environ 4000 lignes
onglet 3 : environ 10000 lignes
Cliquez pour agrandir...

et j'ai déroulé nos 2 codes...

Le tien : 78 secondes
le mien : 12 secondes

Comme quoi le filtre élaboré reste quand même le plus rapide...

Amicalement
 
Vote positif 0 Vote négatif

Discussions similaires

V
  • Question
XL 2021 avoir des données dans plusieurs onglets en fonction de plusieurs conditions
Réponses
5
Affichages
239
mapomme
mapomme
R
  • Résolu(e)
Autres Masquer des lignes et colonnes en fonction d'une valeur d'un menu déroulant
Réponses
1
Affichages
171
Romain77144
R
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
444
Laliepomm
L
S
  • Résolu(e)
Microsoft 365 vba, récupérer le résultat d'un INDEX(EQUIV en fonction du résultat
Réponses
6
Affichages
177
SOP
S
C
  • Question
XL 2016 rapatrier des informations en "scannant" les onglets d'un fichier excel vers les cellules d'un autre onglet
Réponses
6
Affichages
561
job75
job75
A
  • Résolu(e)
Microsoft 365 Nommer des feuilles en fonction des données d'une colonne
Réponses
9
Affichages
324
AD95
A
S
  • Question
XL 2016 Bloquer la MaJ des formules de certains onglets
Réponses
2
Affichages
293
Hasco
Hasco
A
  • Question
Microsoft 365 Afficher la valeur d'une cellule en fonction de 3 conditions via VBA
Réponses
2
Affichages
407
Ay-Ricko
A
B
  • Question
XL 2016 Macro BVA pour créer une synthèse à partir de plusieurs onglets Excel
Réponses
6
Affichages
633
bnolwalid
B
A
  • Question
Microsoft 365 Copie VBA d'un tableau présent et identique sur 12 onglets dans un autre onglet dont seules les lignes complétées sont copiées
Réponses
4
Affichages
466
AlexiaC
A

Membres actuellement en ligne

23 membres et 352 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 548
Messages
2 089 502
Membres
104 192
dernier inscrit
romain.faucon