Discussion :

[chris09300]

Bonjour
je travaille sur excel2007, j'ai un bout d'une application que je suis en train de developper. Quelqu'un a t'il une idee pour incrementer la cellule O15 et de ce fait diminuer la grandeur de cette macro:
merci d'avance.
ci dessus code:

Sub Especes()
Sheets("Feuil2").Activate
Range("J3").Activate
Selection.Copy
Sheets("Menu").Select
Range("O28").Select
ActiveSheet.Paste
If Range("O15") > "0" Then
Sheets("Feuil1").Activate
Range("E4") = "Especes"
Range("B4") = Range("E1")
End If
Sheets("Menu").Select
If Range("O16") > "0" Then
Sheets("Feuil1").Activate
Range("E5") = "Especes"
Range("B5") = Range("E1")
End If
Sheets("Menu").Select
If Range("O17") > "0" Then
Sheets("Feuil1").Activate
Range("E6") = "Especes"
Range("B6") = Range("E1")
End If
Sheets("Menu").Select
If Range("O18") > "0" Then
Sheets("Feuil1").Activate
Range("E7") = "Especes"
Range("B7") = Range("E1")
End If
Sheets("Menu").Select
If Range("O19") > "0" Then
Sheets("Feuil1").Activate
Range("E8") = "Especes"
Range("B8") = Range("E1")
End If
Sheets("Menu").Select
If Range("O20") > "0" Then
Sheets("Feuil1").Activate
Range("E9") = "Especes"
Range("B9") = Range("E1")
End If
Sheets("Menu").Select
If Range("O21") > "0" Then
Sheets("Feuil1").Activate
Range("E10") = "Especes"
Range("B10") = Range("E1")
End If
Sheets("Menu").Select
If Range("O22") > "0" Then
Sheets("Feuil1").Activate
Range("E11") = "Especes"
Range("B11") = Range("E1")
End If
Sheets("Menu").Select
If Range("O23") > "0" Then
Sheets("Feuil1").Activate
Range("E12") = "Especes"
Range("B12") = Range("E1")
End If
Sheets("Menu").Select
If Range("O24") > "0" Then
Sheets("Feuil1").Activate
Range("E13") = "Especes"
Range("B13") = Range("E1")
End If
Sheets("Menu").Select
If Range("O25") > "0" Then
Sheets("Feuil1").Activate
Range("E14") = "Especes"
Range("B14") = Range("E1")
End If
Sheets("Menu").Select
If Range("O26") > "0" Then
Sheets("Feuil1").Activate
Range("E15") = "Especes"
Range("B15") = Range("E1")
End If
Sheets("Menu").Select
If Range("O27") > "0" Then
Sheets("Feuil1").Activate
Range("E16") = "Especes"
Range("B16") = Range("E1")
End If
Sheets("Feuil1").Activate
Range("B4:E20").Select
Selection.Copy

Sheets("Recette journalière").Select
Range("A1516").Select
Selection.Insert Shift:=xlDown
Sheets("Feuil1").Select
Range("B4:E20").Select
Selection.ClearContents
Sheets("Recette journalière").Select
Range("A1545").Select
ActiveWorkbook.Worksheets("Recette journalière").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Recette journalière").Sort.SortFields.Add Key:= _
Range("A15:A45"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("Recette journalière").Sort
.SetRange Range("A1545")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets("Recette journalière").Select
Range("A1").Select
Sheets("Menu").Select
Range("N15:O27,O28").Select
Selection.ClearContents
Range("N2").Select
End Sub

[sabzzz]

bonjour chris,

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
Sub Especes()
Sheets("Feuil2").Range("J3").Copy Sheets("Menu").Range("O28")
 
With Sheets("Feuil1")
For i = 4 To 16
  If Sheets("Menu").Range("O" & i + 11) > "0" Then
  .Range("E" & i) = "Especes"
  .Range("B" & i) = .Range("E1")
End If
 
.Range("B4:E20").Copy
Sheets("Recette journalière").Range("A1516").Insert Shift:=xlDown
 
.Range("B4:E20").ClearContents
End With
 
Sheets("Recette journalière").Select
Range("A1545").Select
ActiveWorkbook.Worksheets("Recette journalière").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Recette journalière").Sort.SortFields.Add Key:= _
Range("A15:A45"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
 
With ActiveWorkbook.Worksheets("Recette journalière").Sort
.SetRange Range("A1545")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
 
Sheets("Menu").Range("N15:O27,O28").ClearContents
 
End Sub

[bosk1000]

bonjour

si je comprend bien ce que tu veux faire, tu as une opération qui se répète de
la feuille menu a partir de "O15" à "O27" pour effectuer toujours la même comparaison qui est si la valeur dans la cellule O est supérieure à 0 alors tu met l'information "espèces" dans la 'feuil1' à partir de la cellule "e4"

par contre pour bien comprendre
je ne comprend pas ce que viens faire la répétition de :
Range("B4") = Range("E1")
Range("B5") = Range("E1")
etc, car tu vas systématiquement effacer l'info en e1
et de plus le b5 et le e1 de quelle feuille

et enfin pour optimiser
est-il possible le cas de figure
o15 est supérieure à 0
o16 est egale à 0
o17 est supperieur à 0

auquel cas, en feuil 1
dans les cellules correspondante il te faudra
A4 = espèces
A5 = ???
A6 = espèces

donc je pense qu'il ne peux y avoir de valeur supérieure à 0 si l'une des cellule de la colonne devient 0, les suivante reste à 0


donc si tu pars sur une option simple
une boucle en for next

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
 
Dim i As Byte, o As Byte
 
Sheets("Feuil2").Range("J3").Copy
ActiveSheet.Paste Destination:=Sheets("Menu").Range("O28")
 
 
 
Sheets("Menu").Activate
For i = 15 To 27
For o = 4 To 16
If Range("o" & i).Value > 0 Then Sheets("Feuil2").Range("e" & o).Value = "Especes"
Next o
Next i
End Sub

donc ce code déja copie l'info de la cellule J3
et ensuite viens informer tous les espèces