rangement automatique des données sur autre feuille

H

HERVE 33

XLDnaute Nouveau
Bonjour à toutes et à tous

Un peu d'aide SVP

Je souhaite saisir des actions par n° affaire et que celle_ci soit classées automatiquement dans une autre feuille.
Toutes les actions sur la même affaire sur la même feuille,

Quelqu'un peut il m'aider SVP

ci joint un fichier exemple
 

Pièces jointes

  • Classeur1.xlsx
    10.5 KB · Affichages: 85
  • Classeur1.xlsx
    10.5 KB · Affichages: 87
  • Classeur1.xlsx
    10.5 KB · Affichages: 88
Trier par date Trier par votes
klin89

klin89

XLDnaute Accro
Re : rangement automatique des données sur autre feuille

Bonsoir le forum :)
Bonsoir et bienvenue Herve 33,

Sous excel 2003, la feuille active doit être la feuille "SAISIE"
VB: 
Sub Creation_Onglets()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Détermine la dernière dernière cellule de la dernière colonne (renvoi du style $P$5)
dercol = Range("A1").SpecialCells(xlCellTypeLastCell).Address
'Détermine le numéro de la dernière colonne
numcol = Cells(1, Columns.Count).End(xlToLeft).Column
'Création du nom défini Base
Range("A1:" & dercol).Name = "Base"
'Création des noms d'intitulés
Cells(1, 1).Name = "Titre1"
Range(Cells(1, 2), Cells(1, numcol)).Name = "Titre2"
'Suppression de toutes les feuilles sauf la 1ère
    For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
    Next i
    'Boucle sur toutes les lignes remplies de la colonne A - A partir de A2
Set Onglet = CreateObject("Scripting.Dictionary")
    For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        'Mise en mémoire des noms des onglets à créer
        If Not Onglet.Exists(cel.Value) Then Onglet.Add cel.Value, cel.Value
    Next cel
    'Boucle sur toutes les noms en mémoire et création de la feuille
    For Each It In Onglet.items
        NouvelleFeuille = Onglet.Item(It)
        On Error Resume Next
        Set connue = Sheets(NouvelleFeuille)
            If Err <> 0 Then Sheets.Add.Name = NouvelleFeuille
        On Error GoTo 0
        'Avec la feuille créée
        With Sheets(NouvelleFeuille)
        'On copie les valeurs des intitulés
            .Cells(3, 1).Value = Range("Titre1").Value
            .Cells(3, 3).Value = NouvelleFeuille
            .Range(Cells(5, 1), Cells(5, numcol)).Value = Range("Titre2").Value
            'Dans la cellule IV1, on écrit n° affaire (valeur de A1 dans la feuille SAISIE)
            .[IV1] = "n° affaire"
            'Dans la cellule IV2, on écrit le nom de la feuille créée
            .[IV2] = NouvelleFeuille
            'Extraction des données de la Base (nom défini)selon les critères inscrits en IV1 et IV2 que l'on copie à partir de A5:O5
            Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
                "IV1:IV2"), CopyToRange:=.Range("A5:O5"), Unique:=False
                'Effacement des valeurs dans les cellules IV1:IV2
            .[IV1:IV2].ClearContents
        End With
    'On passe à la feuille suivante
    Next It
    'On place la feuille SAISIE en 1ère feuille
    Sheets("SAISIE").Move Sheets(1)
    'On affiche la feuille SAISIE
    Sheets("SAISIE").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
J'ai revu la présentation initiale de la feuille "SAISIE", j'ai notamment supprimé les cellule fusionnées.
Je n'ai pas peaufiné la mise en forme.

Klin89
 

Pièces jointes

  • Test_Herve33.xls
    38 KB · Affichages: 94
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : rangement automatique des données sur autre feuille

Bonjour HERVE 33, klin89,

Voyez le fichier joint et cette macro dans ThisWorkbook :

Code: 
Private Sub Workbook_sheetActivate(ByVal Sh As Object)
Dim a, P As Range, i As Variant, h&
With Sheets("SAISIE")
  a = Array(.Name, "Feuil1") 'liste des feuilles à exclure
  If IsNumeric(Application.Match(Sh.Name, a, 0)) Then Exit Sub
  .[A:A].Insert: .[A4] = 1
  Set P = Intersect(.UsedRange, .Rows("4:" & .Rows.Count))
  P.Columns(1).DataSeries
  P.Sort P(1, 2), Header:=xlNo
  i = Application.Match(Sh.Name, P.Columns(2), 0)
  If IsNumeric(i) Then
    h = Application.CountIf(P.Columns(2), Sh.Name)
    P.Cells(i, "C").Resize(h, P.Columns.Count - 2).Copy Sh.[A6]
  End If
  P.Sort P(1)
  .[A:A].Delete
End With
Sh.Rows(6 + h & ":" & Sh.Rows.Count).Delete
End Sub
Fichier joint.

Nota 1 : les noms des 2 feuilles étaient erronés, je les ai corrigés.

Nota 2 : je ne me préoccupe pas de créer les feuilles, à vous de voir quand et comment vous voulez les créer.

Nota 3 : ma méthode n'utilise pas de filtre car les filtres posent problème s'il y a beaucoup de plages disjointes.

A+
 

Pièces jointes

  • Rangement(1).xls
    50.5 KB · Affichages: 44
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : rangement automatique des données sur autre feuille

Re,

Pour créer les feuilles des affaires vous pouvez utiliser cette macro dans le code de la feuille SAISIE :

Code: 
Sub CreerFeuilles()
Dim r As Range, vis As Boolean, nom$
Set r = Intersect(Me.UsedRange, Range("A4:A" & Rows.Count))
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
vis = Sheets("Modèle").Visible
Sheets("Modèle").Visible = True
For Each r In r
  If r <> "" Then
    nom = ""
    nom = Sheets(CStr(r)).Name
    If nom = "" Then
      Sheets("Modèle").Copy After:=Sheets(Sheets.Count)
      Sheets(Sheets.Count).Name = CStr(r)
    End If
  End If
Next
Sheets("Modèle").Visible = vis
Me.Activate
Application.EnableEvents = True
End Sub
La feuille Modèle peut utilement être masquée.

Notez la formule en B3 de la feuille Modèle :

Code: 
=STXT(CELLULE("filename";B3);TROUVE("]";CELLULE("filename";B3))+1;31)
Fichier (2).

A+
 

Pièces jointes

  • Rangement(2).xls
    43 KB · Affichages: 40
  • Rangement(2).xls
    43 KB · Affichages: 44
  • Rangement(2).xls
    43 KB · Affichages: 40
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : rangement automatique des données sur autre feuille

Re,

Pour supprimer les feuilles devenues inutiles on peut utiliser cette macro dans la feuille SAISIE :

Code: 
Sub SupprimerFeuilles()
Dim a, r As Range, w As Worksheet
a = Array(Me.Name, "Modèle") 'liste des feuilles à exclure
Set r = Intersect(Me.UsedRange, Range("A4:A" & Rows.Count))
Application.DisplayAlerts = False
For Each w In Worksheets
  If IsError(Application.Match(w.Name, a, 0)) Then _
    If r Is Nothing Then w.Delete Else _
      If IsError(Application.Match(w.Name, r, 0)) Then w.Delete
Next
End Sub
Nota : on peut faire exécuter cette macro à la fin de la macro CreerFeuilles.

Fichier (3).

A+
 

Pièces jointes

  • Rangement(3).xls
    47.5 KB · Affichages: 36
Vote positif 0 Vote négatif
H

HERVE 33

XLDnaute Nouveau
Re : rangement automatique des données sur autre feuille

:):confused:
job75 à dit:
Bonjour HERVE 33, klin89,

Voyez le fichier joint et cette macro dans ThisWorkbook :

Code: 
Private Sub Workbook_sheetActivate(ByVal Sh As Object)
Dim a, P As Range, i As Variant, h&
With Sheets("SAISIE")
  a = Array(.Name, "Feuil1") 'liste des feuilles à exclure
  If IsNumeric(Application.Match(Sh.Name, a, 0)) Then Exit Sub
  .[A:A].Insert: .[A4] = 1
  Set P = Intersect(.UsedRange, .Rows("4:" & .Rows.Count))
  P.Columns(1).DataSeries
  P.Sort P(1, 2), Header:=xlNo
  i = Application.Match(Sh.Name, P.Columns(2), 0)
  If IsNumeric(i) Then
    h = Application.CountIf(P.Columns(2), Sh.Name)
    P.Cells(i, "C").Resize(h, P.Columns.Count - 2).Copy Sh.[A6]
  End If
  P.Sort P(1)
  .[A:A].Delete
End With
Sh.Rows(6 + h & ":" & Sh.Rows.Count).Delete
End Sub
Fichier joint.

Nota 1 : les noms des 2 feuilles étaient erronés, je les ai corrigés.

Nota 2 : je ne me préoccupe pas de créer les feuilles, à vous de voir quand et comment vous voulez les créer.

Nota 3 : ma méthode n'utilise pas de filtre car les filtres posent problème s'il y a beaucoup de plages disjointes.

A+
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
H

HERVE 33

XLDnaute Nouveau
Re : rangement automatique des données sur autre feuille

Bonjour et merci pour votre aide
Votre fichier fonctionne parfaitement.
Par contre j'ai essayé de copié mes données dans votre fichier et à chaque fois il me créer un nouveau modèle et ajoute une colonne à la feuille saisie.
Ai-je fais un bêtise ???
Merci pour votre réponse
 
Vote positif 0 Vote négatif
H

HERVE 33

XLDnaute Nouveau
Re : rangement automatique des données sur autre feuille

Bonjour
Ci joint le fichier sur lequel je voudrais travailler
A chaque fois que je fais créer le feuilles affaires il me créer un nouveau modèle et il me créer une nouvelle colonne dans la feuille saisie.

Merci pour votre aide

Hervé








klin89 à dit:
Bonsoir le forum :)
Bonsoir et bienvenue Herve 33,

Sous excel 2003, la feuille active doit être la feuille "SAISIE"
VB: 
Sub Creation_Onglets()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Détermine la dernière dernière cellule de la dernière colonne (renvoi du style $P$5)
dercol = Range("A1").SpecialCells(xlCellTypeLastCell).Address
'Détermine le numéro de la dernière colonne
numcol = Cells(1, Columns.Count).End(xlToLeft).Column
'Création du nom défini Base
Range("A1:" & dercol).Name = "Base"
'Création des noms d'intitulés
Cells(1, 1).Name = "Titre1"
Range(Cells(1, 2), Cells(1, numcol)).Name = "Titre2"
'Suppression de toutes les feuilles sauf la 1ère
    For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
    Next i
    'Boucle sur toutes les lignes remplies de la colonne A - A partir de A2
Set Onglet = CreateObject("Scripting.Dictionary")
    For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        'Mise en mémoire des noms des onglets à créer
        If Not Onglet.Exists(cel.Value) Then Onglet.Add cel.Value, cel.Value
    Next cel
    'Boucle sur toutes les noms en mémoire et création de la feuille
    For Each It In Onglet.items
        NouvelleFeuille = Onglet.Item(It)
        On Error Resume Next
        Set connue = Sheets(NouvelleFeuille)
            If Err <> 0 Then Sheets.Add.Name = NouvelleFeuille
        On Error GoTo 0
        'Avec la feuille créée
        With Sheets(NouvelleFeuille)
        'On copie les valeurs des intitulés
            .Cells(3, 1).Value = Range("Titre1").Value
            .Cells(3, 3).Value = NouvelleFeuille
            .Range(Cells(5, 1), Cells(5, numcol)).Value = Range("Titre2").Value
            'Dans la cellule IV1, on écrit n° affaire (valeur de A1 dans la feuille SAISIE)
            .[IV1] = "n° affaire"
            'Dans la cellule IV2, on écrit le nom de la feuille créée
            .[IV2] = NouvelleFeuille
            'Extraction des données de la Base (nom défini)selon les critères inscrits en IV1 et IV2 que l'on copie à partir de A5:O5
            Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
                "IV1:IV2"), CopyToRange:=.Range("A5:O5"), Unique:=False
                'Effacement des valeurs dans les cellules IV1:IV2
            .[IV1:IV2].ClearContents
        End With
    'On passe à la feuille suivante
    Next It
    'On place la feuille SAISIE en 1ère feuille
    Sheets("SAISIE").Move Sheets(1)
    'On affiche la feuille SAISIE
    Sheets("SAISIE").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
J'ai revu la présentation initiale de la feuille "SAISIE", j'ai notamment supprimé les cellule fusionnées.
Je n'ai pas peaufiné la mise en forme.

Klin89
Cliquez pour agrandir...
 

Pièces jointes

  • travail 2.xlsm
    166.4 KB · Affichages: 89
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : rangement automatique des données sur autre feuille

Bonjour HERVE 33, le forum,

Vous vous rendez compte j'espère que la feuille SAISIE de votre dernier fichier est différente de celle de votre 1er fichier.

Le tableau commence en colonne E (au lieu de A) et en ligne 3 (au lieu de 4).

De plus il y a la feuille DOSSIER qu'il faut exclure du traitement.

Il faut donc adapter les 3 macros que je vous ai données.

Pas très difficile si l'on fait l'effort d'essayer de les comprendre.

Ci-joint votre fichier avec les macros modifiées.

REMARQUE IMPORTANTE :

Quand vous lancez la macro CreerFeuilles (Ctrl+C) il se crée une feuille Modèle (2).

En effet cette feuille ne peut pas être renommée avec le texte 53158/10SA5-53278 qui se trouve en E83 de la feuille SAISIE.

Ce texte contient en effet un slash "/" qui est un caractère interdit dans les noms de feuilles.

Mettez donc un tiret "-" à la place de "/" en E83 et relancez la macro CreerFeuilles.

EDIT : comme on y insère une colonne A auxiliaire, la feuille SAISIE ne doit pas être protégée...

A+
 

Pièces jointes

  • travail 2(1).xlsm
    131.1 KB · Affichages: 53
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 To do list
Réponses
1
Affichages
481
chris
chris
P
  • Question
Microsoft 365 comment synchroniser les donner d'un tableau avec 1 autre sur une autre feuille
Réponses
7
Affichages
500
patrick965
P
Neo Hyuga
  • Question
XL 2016 Conception et faisabilité
Réponses
8
Affichages
378
Neo Hyuga
Neo Hyuga
C
  • Résolu(e)
XL 2010 Recherche (vers 2)
Réponses
5
Affichages
231
CATPLUS
C
M
  • Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
253
sylvanu
sylvanu
C
  • Question
Microsoft 365 Répétition action sur plusieurs feuille d'un classeur
Réponses
4
Affichages
320
sylvanu
sylvanu
L
  • Résolu(e)
Microsoft 365 Trier données vers une autre Feuille,suivant Critères
Réponses
4
Affichages
318
Phil69970
Phil69970
O
  • Résolu(e)
XL 2019 Gestion de métrage restant sur une bobine
2 3
Réponses
34
Affichages
917
JM27
J
R
  • Résolu(e)
Power Query Fonction pour Lister dans Powerquery
2
Réponses
15
Affichages
347
mromain
mromain
F
  • Question
XL 2021 Création d'une feuille de dépouillement élections
Réponses
3
Affichages
127
sylvanu
sylvanu

Membres actuellement en ligne

12 membres et 128 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 559
Messages
2 089 600
Membres
104 221
dernier inscrit
legendking85