problème entre 2 macro

**JBeaunez** · 14/02/2012, 09h22

Bonjour à tous,

Voila mon problème, j'ai créer un fichier excel servant à planifier les tâches des salariés tout les jours,
seulement voila mon classeur est constitué de deux macro, une pour recopier automatiquement les taches dans des tableaux individuels correspondant aux salariés ( un pour chacun ) et une autre macro afin de recopier automatiquement les meubles associés aux tâches dans le même tableau individuel.

Le problème étant que lorsque je click le bouton affecter à la macro des tâches, les tâches se recopie parfaitement, mais supprime les meubles dans la colonne d'à côté.

Et lorsque je fais l'inverse, les meubles se recopient mais supprime à son tour les tâches...
J'en conclus donc que mes macros doivent avoir un défaut.

Quelqu'un pourrait - il m'aider et jeter un oeil sur mes macros ?

Cordialement
Justine ( qui est totalement desespérée et attend une réponse positive de votre part !

**jfontaine** · 14/02/2012, 09h53

Bonjour,

Quelqu'un pourrait - il m'aider et jeter un oeil sur mes macros ?

Pour cela, il faudrait voir les macros

**JBeaunez** · 14/02/2012, 10h20

Oui je sais bien, j'attendais que quelqu'un veuille bien m'aider !
Je te copie les macros desuite ; merci !

Permière macro pour la recopie des taches :

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
Dim Lg&, i&
Range("I6:I100").Select
Selection.Copy
Range("B6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("J6:J100").Select
Application.CutCopyMode = False
Selection.Copy
Range("B106").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("K6:K100").Select
Application.CutCopyMode = False
Selection.Copy
Range("B206").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("L6:L100").Select
Application.CutCopyMode = False
Selection.Copy
Range("B306").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
 
'--- supprime espaces et lignes vides ---
Lg = Range("b" & Rows.Count).End(xlUp).Row
For i = Lg To 6 Step -1
Cells(i, "b").Value = Trim(Cells(i, "b").Value) 'espace ou apostrophe
If IsEmpty(Cells(i, "b")) Then Range("a" & i).Resize(1, 3).Delete Shift:=xlUp
Next i
'--- bordures ---
With Range("a6:c" & Lg)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlInsideVertical).Weight = xlThin
End With
Application.Goto Range("a1"), Scroll:=True
 
End Sub

Je voulais également enregistrer un collage spécial pour le format, afin que les bordures de lignes s'affichent, mais elles s'effacent également.

Deuxième macro pour la recopie des meubles ( qui est en soit pratiquement la même, d'ou le bug certainement je ne sais pas ) :

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
54
55
56
57
58
59
60
61
62
63
Range("M6:M100").Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-6
Range("C6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.ScrollColumn = 9
Application.CutCopyMode = False
Range("N6:N100").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-8
ActiveWindow.ScrollRow = 111
ActiveWindow.SmallScroll Down:=-9
Range("C106").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 36
ActiveWindow.SmallScroll Down:=-39
Range("O6:O100").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-7
ActiveWindow.ScrollRow = 166
ActiveWindow.SmallScroll Down:=18
Range("C206").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.ScrollColumn = 9
ActiveWindow.SmallScroll Down:=-48
ActiveWindow.ScrollRow = 16
ActiveWindow.SmallScroll Down:=-12
Range("P6:P100").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-8
ActiveWindow.ScrollRow = 210
ActiveWindow.SmallScroll Down:=-12
Range("C206").Select
ActiveWindow.SmallScroll Down:=93
Range("C306").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ActiveWindow.ScrollRow = 1
'--- supprime espaces et lignes vides ---
Lg = Range("c" & Rows.Count).End(xlUp).Row
For i = Lg To 6 Step -1
Cells(i, "c").Value = Trim(Cells(i, "c").Value) 'espace ou apostrophe
If IsEmpty(Cells(i, "c")) Then Range("a" & i).Resize(1, 3).Delete Shift:=xlUp
Next i
'--- bordures ---
With Range("a6:c" & Lg)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlInsideVertical).Weight = xlThin
End With
Application.Goto Range("a1"), Scroll:=True
'
End Sub

**jfontaine** · 14/02/2012, 10h43

Dans un premier temps, on va faire un peu de ménage dans ton 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
 
Dim Lg As Long
Dim i As Long
 
Range("I6:I100").Copy
Range("B6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("B6").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("J6:J100").Copy
Range("B106").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("B106").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("K6:K100").Copy
Range("B206").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("B206").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("L6:L100").Copy
Range("B306").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
'--- supprime espaces et lignes vides ---
Lg = Range("b" & Rows.Count).End(xlUp).Row
For i = Lg To 6 Step -1
    Cells(i, "b").Value = Trim(Cells(i, "b").Value) 'espace ou apostrophe
    If IsEmpty(Cells(i, "b")) Then Range("a" & i).Resize(1, 3).Delete Shift:=xlUp
Next i
 
'--- bordures ---
With Range("a6:c" & Lg)
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlInsideVertical).Weight = xlThin
End With
 
Range("a1").Select

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
Range("M6:M100").Copy
Range("C6").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("N6:N100").Copy
Range("C106").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("O6:O100").Copy
Range("C206").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
Range("P6:P100").Copy
Range("C306").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
'--- supprime espaces et lignes vides ---
Lg = Range("c" & Rows.Count).End(xlUp).Row
For i = Lg To 6 Step -1
    Cells(i, "c").Value = Trim(Cells(i, "c").Value) 'espace ou apostrophe
    If IsEmpty(Cells(i, "c")) Then Range("a" & i).Resize(1, 3).Delete Shift:=xlUp
Next i
 
'--- bordures ---
With Range("a6:c" & Lg)
    .Borders(xlEdgeLeft).Weight = xlMedium
    .Borders(xlEdgeTop).Weight = xlMedium
    .Borders(xlEdgeBottom).Weight = xlMedium
    .Borders(xlEdgeRight).Weight = xlMedium
    .Borders(xlInsideVertical).Weight = xlThin
End With
 
Range("a1").Select

**JBeaunez** · 14/02/2012, 11h00

Merci c'est beaucoup plus clair déjà !
Par contre je viens de réessayer et la recopie de la colonne B efface toujours la recopie de la colonne C !

Croyez vous que ça soit dans la macro ?
Je regardé, et reregardé mais je ne trouve pas ce qu'il ne vas pas.

Peut être qu'avec mon fichier cela sera plus simple ?

Ma macro pour les tâches est la macro4
La macro des meubles est la macro "johnny", désolé pour le nom mais j'en ai tellement essayé qu'au final j'ai taper ce qu'il me passé par la tête pour les essayer !

Je les remplacer par les votre qui sont bcp plus claires !

Pour les tâches ils suffis de cliquer sur le bouton copier, et pour les effacer et remmettre le fichier a zéro, le bouton d'en dessous.

Merci d'avance de passer du temps sur mes petits soucis informatiques !

**jfontaine** · 14/02/2012, 11h38

Aurais tu un fichier avec un onglet Avant et un Onglet Après

**JBeaunez** · 14/02/2012, 11h59

Non je n'ai pas d'onglet avant, aprés, pourquoi me demandez vous ça ?

Etes vous arrivé à l'ouvrir ? et comprenez vous son fonctionnement ?

**jfontaine** · 14/02/2012, 12h12

Dans la macro 2 utiliser la ligne ci dessous

Code :

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

If IsEmpty(Cells(i, "c")) Then Range("c" & i).Resize(1, 3).Delete Shift:=xlUp

**JBeaunez** · 14/02/2012, 12h20

Cela marche parfaitement !

Merci beaucoup de votre aide, quelle éfficacité !
Je me voyais déjà ne jamais y arriver !

Merci encore, et bonne journée !

problème entre 2 macro

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager