Macro a completer

**MISTERJUNGLE330** · 28/01/2014, 23h05

Bonsoir le forum,
j'ai un tableau horaires en colonne "F" doit se trouver les Intitulés suivant:
"CP","RTTD","SAM","DIM" etc...mon code est le suivant:

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
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B6:NB41")) Is Nothing Then
onglet = Cells(x, 1)
lejour = Format(Cells(4, y), "dd/mmmm/yyyy")
Sheets(onglet).Cells(y + 2, 6) = Cells(x, y).Value
Sheets(onglet).Cells(y + 2, 1) = lejour
If Cells(x, y) = "" Then Sheets(onglet).Cells(y + 2, 1) = ""
End If
If Target.Address <> "$A$4" Then Exit Sub
Application.ScreenUpdating = False
Columns("B:NB").Hidden = True
Select Case Target
Case "Année complète"
Columns("B:NB").Hidden = False
Case "Janvier"
Columns("B:AF").Hidden = False
Case "Février"
Columns("AG:BH").Hidden = False
Case "Mars"
Columns("BI:CM").Hidden = False
Case "Avril"
Columns("CN:DQ").Hidden = False
Case "Mai"
Columns("DR:EV").Hidden = False
Case "Juin"
Columns("EW:FZ").Hidden = False
Case "Juillet"
Columns("GA:HE").Hidden = False
Case "Août"
Columns("HF:IJ").Hidden = False
Case "Septembre"
Columns("IK:JN").Hidden = False
Case "Octobre"
Columns("JO:KS").Hidden = False
Case "Novembre"
Columns("KT:LW").Hidden = False
Case "Décembre"
Columns("LX:NB").Hidden = False
End Select
Application.ScreenUpdating = True
End Sub

la ligne en rouge correspond au renvoi en colonne "F"
par contre je n'arrive pas a intégrer en plus ce morceau de code

Code :

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

Sheets(onglet).Cells(y + 2, 7) = Cells(x, y).Value

qui me renverrai mes données dans la colonne "G" uniquement pour les "NUIT"
merci par avance de votre aide

**nibledispo** · 29/01/2014, 02h04

Bonjour,

Peux-tu expliquer ce que sont x et y ?
En l'état, sauf incompréhension de ma part, ils ne représentent rien pour VBA et devraient entrainer une erreur.

cordialement,

**MISTERJUNGLE330** · 29/01/2014, 08h05

Bonjour le Nibledispo et le Forum,
je suis désolé, je ne n'ai pas fait attention il manqué un bout de code:

Code :

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

1
2
3
4
5
6
7
8
Public x, y As Long
Public onglet As String
Public lejour As Date
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
x = ActiveCell.Row
y = ActiveCell.Column
End Sub

et ensuite dans un module code suivant:

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
Function NomOnglet()
    Application.Volatile
    NomOnglet = Application.Caller.Parent.Name
End Function
 
Public Sub charge_FNOMS()
Application.Calculation = xlCalculationManual
        If Sheets("LISTE").Range("L1") <> "" Then
        Application.EnableEvents = False
            fin = Sheets("LISTE").Range("L1").End(xlDown).Row
                For uy = 1 To fin
                    For uz = 1 To 366
                        x = uy + 5
                        y = uz + 1
                        jh = Sheets("PLANNING 2014").Cells(uy + 5, uz + 1)
 
                            If Sheets("PLANNING 2014").Cells(uy + 5, uz + 1) <> "" Then
 
 
                                onglet = Sheets("PLANNING 2014").Cells(x, 1)
                                lejour = Format(Sheets("PLANNING 2014").Cells(4, y), "dddd d mmmm")
                                Sheets(onglet).Cells(y + 2, 6) = Sheets("PLANNING 2014").Cells(x, y).Value
                                Sheets(onglet).Cells(y + 2, 1) = lejour
                                If Sheets("PLANNING 2014").Cells(x, y) = "" Then Sheets(onglet).Cells(y + 2, 1) = ""
                            End If
                    Next uz
                Next uy
            Application.EnableEvents = True
        End If
Application.Calculation = xlCalculationAutomatic
End Sub

je m'explique dans une feuille se trouve mon planning
_a partir de la ligne "A6" jusques la ligne "A41" se trouve les noms des personnes.
_de la colonne "B4" a "NB41" se sont les dates
_ et chaque cellule de ce tableau est alimenté par :"CP" "DIM" "SAM" "NUIT"...

puis transfert des données sur:

SUR une autre Feuille (personnelle a chaque employé) se trouve:
en colonne "A"_les dates
en colonne " B,C,D,E" _les heures
en colonne "F" l'intitulé_ "CP" "DIM" "SAM" "REPAS"....
en colonne "G" _ "NUIT" (uniquement cette dénomination )

**nibledispo** · 29/01/2014, 15h34

Bonjour,

En partant du code de ta derniere intervention (proche du code 1ere intervention), n'est-ce pas cela que tu cherches à obtenir ?
je ne suis pas convaincu que les instructions "enableEvents" ait une utilité.

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
 
Public Sub charge_FNOMS()  'dans un module
Application.Calculation = xlCalculationManual
        If Sheets("LISTE").Range("L1") <> "" Then
            Application.EnableEvents = False
            fin = Sheets("LISTE").Range("L1").End(xlDown).Row
                For uy = 1 To fin
                    For uz = 1 To 366
                        x = uy + 5
                        y = uz + 1
                        jh = Sheets("PLANNING 2014").Cells(x, y)
 
                        If jh <> "" Then
                            onglet = Sheets("PLANNING 2014").Cells(x, 1)
                            lejour = Format(Sheets("PLANNING 2014").Cells(4, y), "dddd d mmmm")
                            Sheets(onglet).Cells(y + 2, 1) = lejour
 
                            If jh.Value = "nuit" Then
                               Sheets(onglet).Cells(y + 2, 7) = jh.Value
                            Else
                               Sheets(onglet).Cells(y + 2, 6) = jh.Value
                            End If
                        End If
                    Next uz
                Next uy
            Application.EnableEvents = True
        End If
Application.Calculation = xlCalculationAutomatic
End Sub

Cordialement,

**MISTERJUNGLE330** · 29/01/2014, 16h29

Bonjour Paul et le Forum,
cela ne marche pas.
puis je t'envoyer un morceau du fichier ?
merci

**nibledispo** · 29/01/2014, 22h49

Bonsoir,

Il faudrait déjà savoir si ce que j'ai mis dans cette sub ne devrait pas être logé dans la sub "workshett_change" car il semble que x et y sont les coordonnées de "target".

Par ailleurs, avoir des lignes d'instructions qui font la même chose dans deux sub donne à penser que le code est mal ficelé.Essai de mettre les lignes d'instructions dans Workshett_change.

J'ai de gros soucis avec mon Office et ne charge plus les fichiers des intervenants sur mon ordinateur tant que le problème ne sera pas réglé.

Cordialement,

**MISTERJUNGLE330** · 30/01/2014, 11h26

Bonjour le Forum,
ci joint mon fichier, sur la feuille "LUC" se trouve les explications
merci pour votre aide car je devient "dingue"

**nibledispo** · 31/01/2014, 14h41

Bonjour,

Comme je te l'ai écrit, je préfère pour l'instant ne pas ouvrir les fichiers contenant des macros.
As-tu essayé de mettre les lignes de code que je t'ai proposé dans la worksheet_change ?

Par ailleurs, fait du pas à pas (touche F8) pour voir exactement ce que fait VBA et repérer l'endroit bloquant.

Cordialement,

Macro a completer

Macros et VBA Excel

Discussions similaires

Partager

Partager