problème Macro

[Marion]

Bonsoir le forum.

Je reviens juste, je n'est pas encore répondu au post d'avant hier mais mais j'y vais juste aprés ça.

Baside ma fait une macro mais elle ne fonctionne plus et je ne sais pas pouquoi.

La zone BDD est bien définie
voici la macro

Dim Chang As Integer
Dim C As Integer
Dim Col As Byte
Dim Nom As String
Dim L As Integer

Sub OUI_NON()
' CHANGER LE NOM DE LA FEUILLE ICI LE METTRE ENTRE ' '
Nom = 'SAISIE QUANTITE'
' Contrôles remplissage des dates
If Worksheets(Nom).Range('AS3') = '' Then MsgBox ' Date': Exit Sub
If Worksheets(Nom).Range('AU3') = '' Then MsgBox ' Date': Exit Sub
Worksheets(Nom).Range('AQ2') = '>=' & Worksheets(Nom).Range('AS3')
Worksheets(Nom).Range('AR2') = '<=' & Worksheets(Nom).Range('AU3')
Worksheets(Nom).Range('AT2') = '>=' & Worksheets(Nom).Range('AS3')
Worksheets(Nom).Range('AU2') = '<=' & Worksheets(Nom).Range('AU3')
' Recherche sezlon critères
Application.ScreenUpdating = False

la macro s'arrête juste ne dessous pourquoi???????????

Range('BDD').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
'AQ1:AS2'), CopyToRange:=Range('AR5:AS200'), Unique:=False
Range('BDD').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
'AT1:AV2'), CopyToRange:=Range('AT5:AU200'), Unique:=False
ActiveWindow.SmallScroll Down:=-15

' Ordre alphabètique
Range('AR6:AS20').Select
Selection.Sort Key1:=Range('AR6'), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range('AT6:AU20').Select
Selection.Sort Key1:=Range('AT6'), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Chang = 6 To 3000
If Sheets(Nom).Range('AS' & Chang) = 'oui' Then Sheets(Nom).Range('AS' & Chang).Value = 1
If Sheets(Nom).Range('AU' & Chang) = 'non' Then Sheets(Nom).Range('AU' & Chang).Value = 1
Next

' Elimination des doublons et addition dans les cellules à droite
L = Sheets(Nom).Range('AR20').End(xlUp).Row
Col = 44
For C = 5 To L
If Sheets(Nom).Cells(C, Col).Value = '' Then Exit For
If Sheets(Nom).Cells(C, Col) = Sheets(Nom).Cells(C + 1, Col) Then _
Sheets(Nom).Cells(C, Col + 1).Value = Sheets(Nom).Cells(C, Col + 1).Value + 1: _
Cells(C + 1, Col).Delete shift:=xlUp: Cells(C + 1, Col + 1).Delete shift:=xlUp
Next

L = Sheets(Nom).Range('AT65536').End(xlUp).Row
Col = 46
For C = 5 To L
If Sheets(Nom).Cells(C, Col).Value = '' Then Exit For
If Sheets(Nom).Cells(C, Col) = Sheets(Nom).Cells(C + 1, Col) Then _
Sheets(Nom).Cells(C, Col + 1).Value = Sheets(Nom).Cells(C, Col + 1).Value + 1: _
Cells(C + 1, Col).Delete shift:=xlUp: Cells(C + 1, Col + 1).Delete shift:=xlUp
Next

' Mise en forme des cellules
Range('AR6:AU20').Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Range('A1').Select
Application.ScreenUpdating = True
End Sub
merci A+Marion

 

[ChTi160]

salut Marion
bonsoir le Forum

peux tu me dire à quoi correspond la partie en gras
Range('BDD').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
'AQ1:AS2'), CopyToRange:=Range('AR5:AS200'), Unique:=False
Range('BDD').AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
'AT1:AV2'), CopyToRange:=Range('AT5:AU200'), Unique:=False
ActiveWindow.SmallScroll Down:=-15
si celà correspond à une plage nommée il faut enlevé je pense les guillemets sinon dit moi ce que c'est

 

[Baside]

Bonsoir Marion le forum

As tu toucher quelque chose o&ugrave; j'avais mis des post it ?

Sinon post la feuille que je regarde

Baside

 

[Baside]

Bonsoir ChTi160

Quand j'ai vu ma macro, j'ai répondu tellement vite que je n'ai pas vu ton post

Bonne soirée, Baside

 

[Marion]

Bonsoir a tous les deux, et a l'ensemble du forum.


Je reviens juste pas eu le temps de regarder en détail.


Baside je ne peut pas te faire passer le fichier il est trop gros.

mais j'ai des problème la macro bug au niveau du BDD enfin je crois.

pour ce soir je vais me coucher car la fatigue est là.

je revois ça demain.



A+Marion


bonne nuit a toutes et a tous