Discussion :

[typhoon751]

Bonjour,

J'essaye de réaliser un traitement d'un fichier excel que je vous joins si vous pouvez m'aider.
J'ai déjà réaliser quelques requêtes correspondant à mes demandes mais la je coince:
Voici mon code pour l'instant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub extract()
    Dim plage As Range
    Dim cellule As Range
    Dim feuille As Worksheet
    Dim nomPersonne As String
 
    Set plage = Worksheets(1).Range("B8", Worksheets(1).Range("B8").End(xlDown))
 
    For Each cellule In plage
        If cellule.Value <> cellule.Offset(-1, 0).Value Then
            Dim nouvelleFeuille As Worksheet
            Set nouvelleFeuille = Worksheets.Add
 
            nouvelleFeuille.Name = cellule.Value
        End If
    Next cellule
 
    For Each feuille In Worksheets
        nomPersonne = feuille.Name
 
        Set plage = Worksheets("Feuil1").Range("B8", Worksheets("Feuil1").Range("B8").End(xlDown))
        Dim nbLigne As Integer
        nbLigne = 1
        For Each cellule In plage
            If cellule.Value = nomPersonne Then
                Worksheets("Feuil1").Range(cellule, cellule.End(xlToRight)).Copy Destination:=Sheets(feuille.Name).Range(Sheets(feuille.Name).Range("A1").Offset(nbLigne, 0).Address)
                nbLigne = nbLigne + 1
            End If
        Next cellule
 
        Next feuille
End Sub

Je dois réaliser ces requetes:
- Création d'un sous-dossier par agent ==> OK
- Extraction des colonnes B,D,E,F,G,H,J,K,N,O,P,Q ==> OK, mais j'exporte toutes les colonnes
- Sommation des colonnes G,H,J,K,N,O,P,Q ==> Pas encore fait!!
- Création des colonnes U et V: ==> Pas encore fait!!
U = Temps de logon > 1 heure
V = Temps de logon < 1 heure
- Sommation des colonnes U et V ==> Pas encore fait!!

Je ne sais pas si je me suis bien fait comprendre.

En attendant, merci à tous ceux qui se pencheront sur le problème.

[ANOVA]

Pour récupérer uniquement les colonnes B,D,E,F,G,H,J,K,N,O,P,Q plutôt que d'avoir toutes les colonnes, je te propose de garder ton code tel quel et juste de rajouter un bout de code qui supprime les colonnes qui sont en trop (si tu ne sais pas le faire, tu devrais pouvoir adapter un macro enregistrée).

Sinon, pour la sommation des colonnes G,H,J,K,N,O,P,Q, c'est simplissime. On ne peut pas le faire à ta place étant donné qu'on ne sait pas ce que tu souhaites faire. Idem pour le reste.

[typhoon751]

Merci ANOVA une nouvelle foi pour ta réponse,
Excuse moi de te répondre si tard, j'étais en déplacement c'est 2 derniers jours.
Effectivement, c'est ce j'ai fais, rajouter du code pour supprimer les colonnes après.
Je te montre mon code est t'explique mon problème après:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub extract()
    Dim plage As Range
    Dim cellule As Range
    Dim feuille As Worksheet
    Dim nomPersonne As String
 
    Set plage = Worksheets(1).Range("B8", Worksheets(1).Range("B8").End(xlDown))
 
    For Each cellule In plage
        If cellule.Value <> cellule.Offset(-1, 0).Value Then
            Dim nouvelleFeuille As Worksheet
            Set nouvelleFeuille = Worksheets.Add
 
            nouvelleFeuille.Name = cellule.Value
        End If
    Next cellule
 
    For Each feuille In Worksheets
        nomPersonne = feuille.Name
 
        Set plage = Worksheets("Feuil1").Range("B8", Worksheets("Feuil1").Range("B8").End(xlDown))
        Dim nbLigne As Integer
        nbLigne = 1
        For Each cellule In plage
            If cellule.Value = nomPersonne Then
                Worksheets("Feuil1").Range(cellule, cellule.End(xlToRight)).Copy Destination:=Sheets(feuille.Name).Range(Sheets(feuille.Name).Range("A1").Offset(nbLigne, 0).Address)
                nbLigne = nbLigne + 1
            End If
        Next cellule
 
     For Each cellule In plage
            If cellule.Value = nomPersonne Then
                Worksheets(feuille.Name).Select
                Range("C:C,I:I,L:L,M:M,R:R,S:S,T:T,U:U").Select
                Range("U1").Activate
                Selection.Delete Shift:=xlToLeft
 
            End If
        Next cellule
 
      Next feuille
End Sub

Je ne sais pas si je m'y suis bien pris, ce code supprime bien mes colonnes, mais aussi celle que je veux conserver, donc mon tableau ne fait plus que 2 colonnes au final. C'est la que je bloque et pourtant je pense utiliser la bonne méthode.

Quand à la sommation et la création des news colonnes, je penses pouvoir m'en sortir.

Aurais tu une idée?
Merci

[ANOVA]

Voici un bout de code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Option Explicit
 
Sub toto()
    Dim plage As Range
    Dim cellule As Range
 
    Set plage = Worksheets(1).Range("B8", Worksheets(1).Range("B8").End(xlDown))
 
    For Each cellule In plage
        If cellule.Value <> cellule.Offset(-1, 0).Value Then
            Dim nouvelleFeuille As Worksheet
            Set nouvelleFeuille = Worksheets.Add
 
            nouvelleFeuille.Name = cellule.Value
        End If
    Next cellule
 
End Sub
 
Sub toto2()
    Dim feuille As Worksheet
    Dim nomPersonne As String
 
    For Each feuille In Worksheets
        nomPersonne = feuille.Name
        Dim plage As Range
        Dim cellule As Range
 
        Set plage = Worksheets("Feuil1").Range("B8", Worksheets("Feuil1").Range("B8").End(xlDown))
        Dim nbLigne As Integer
        nbLigne = 1
        For Each cellule In plage
            If cellule.Value = nomPersonne Then
                Worksheets("Feuil1").Range(cellule, cellule.End(xlToRight)).Copy Destination:=Sheets(feuille.Name).Range(Sheets(feuille.Name).Range("A1").Offset(nbLigne, 0).Address)
                nbLigne = nbLigne + 1
            End If
        Next cellule
    Next feuille
End Sub
 
Sub toto3()
    Dim feuille As Worksheet
 
    For Each feuille In Worksheets
        If feuille.Name <> "Feuil1" Then
            feuille.Columns(1).Delete
            feuille.Columns(1).Delete
            feuille.Columns(1).Delete
            feuille.Columns(5).Delete
            feuille.Columns(5).Delete
        End If
    Next feuille
End Sub

Les deux premières Sub sont celles que nous avions utilisées dans une autre discussion. J'ai rajouté la Sub toto3 qui supprime ce qu'il y a en trop.

Cette sub n'est pas complète, il y a encore quelques colonnes à supprimer, je te laisse terminer le truc car ce sera plus rapide si c'est toi qui le fais (tu sais ce qu'il faut supprimer et ce qu'il faut garder). Normalement, avec ce bout de code, tu as de quoi parvenir à ce que tu souhaites.

[typhoon751]

Merci encore ANOVA,
je passe le poste en résolu!!