problème entre 2 macro

Version imprimable

14/02/2012, 09h22
JBeaunez

problème entre 2 macro

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 ! :)
14/02/2012, 09h53
jfontaine

Bonjour,

Citation:

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

Pour cela, il faudrait voir les macros :calim2:

macros

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:

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:

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

Dans un premier temps, on va faire un peu de ménage dans ton code

Code:

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:

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

14/02/2012, 11h00
JBeaunez

1 pièce(s) jointe(s)

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 !
14/02/2012, 11h38
jfontaine

Aurais tu un fichier avec un onglet Avant et un Onglet Après
14/02/2012, 11h59
JBeaunez

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 ?
14/02/2012, 12h12
jfontaine

Dans la macro 2 utiliser la ligne ci dessous

Code:

If IsEmpty(Cells(i, "c")) Then Range("c" & i).Resize(1, 3).Delete Shift:=xlUp
14/02/2012, 12h20
JBeaunez

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 !