Filtrer, trier, copier, coller, annuler la sélection

JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 14 juin 2017 à 20:55 - Dernière réponse : JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention
- 20 juin 2017 à 10:02
Bonjour,
Je reviens avec mes questions de débutante…

J'ai une BDD dans la feuille unique "PROGRAMME" d'un classeur . Cette BDD est très lourde (A1:CF383)
Je dois filtrer dans ma BDD la colonne 7 et et trier par ordre croissant les villes de la colonne 2. Jusque là, rien de bien sorcier.
Le hic est que je dois faire l'opération 12 fois (la colonne 7 a 12 valeurs différentes) et que je dois copier la selection filtrée dans 12 feuilles différentes (valeur 1, valeur 2, valeur 3 etc).
J'ai écrit un bout du code et vous allez me prendre pour une fois car l'action pour le filtre de la valeur 1 je la répète 12 fois (je sais, c'est moche). Le truc, c'est que j'ai bien mes 12 feuilles qui se créent mais juste avec l'entete de la BDD, pas de valeur. En regardant pourquoi, je me suis rendue compte que sur ma feuille "PROGRAMME" dès que le filtre sur la 1ere valeur a été fait et la macro exécutée, ma base de départ reste filtrée. Du coup, je n'ai plus de données à filtrer pour les autres pages… NORMAL

Comment faire svp?

Merci d'avance pour votre aide précieuse
Voici mon code:
Sub TriDLV()

Dim wsDLV1 As Worksheet
Dim wsDLV2 As Worksheet
Dim wsDLV3 As Worksheet
Dim wsDLV4 As Worksheet
Dim wsDLV5 As Worksheet
Dim wsDLV6 As Worksheet
Dim wsDLV7 As Worksheet
Dim wsDLV8 As Worksheet
Dim wsDLV9 As Worksheet
Dim wsDLV10 As Worksheet
Dim wsDLV11 As Worksheet
Dim wsDLV12 As Worksheet
Dim wsPAROIS_DEFORMABLES As Worksheet



'DLV1


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="1"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV1 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV1.Name = "DLV1"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV2


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="2"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV2 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV2.Name = "DLV2"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV3


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="3"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV3 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV3.Name = "DLV3"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV4


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="4"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV4 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV4.Name = "DLV4"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV5


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="5"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV5 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV5.Name = "DLV5"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV6


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="1"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV6 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV6.Name = "DLV6"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV7


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="7"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV7 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV7.Name = "DLV7"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV8


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="8"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV8 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV8.Name = "DLV8"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV9


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="9"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV9 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV9.Name = "DLV9"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV10


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="10"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV10 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV10.Name = "DLV10"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV11


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="11"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV11 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV11.Name = "DLV11"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'DLV12


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:="12"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsDLV12 = Sheets.Add(After:=Sheets(Sheets.Count))
wsDLV12.Name = "DLV12"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False

'PAROIS DEFORMABLES


ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=26, Criteria1:="PAROIS DEFORMABLES"
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsPAROIS_DEFORMABLES = Sheets.Add(After:=Sheets(Sheets.Count))
wsPAROIS_DEFORMABLES.Name = "PAROIS_DEFORMABLES"
Range("A1").Select
ActiveSheet.Paste

Application.CutCopyMode = False


End Sub

Afficher la suite 
56Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention

34 réponses

Répondre au sujet
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - 14 juin 2017 à 21:22
+1
Utile
bonjour, pour commencer, je propose de simplifier ainsi:

Sub TriDLV() 
call dlv("1")
call dlv("2")
call dlv("3")
call dlv("4")
call dlv("5")
call dlv("6")
call dlv("7")
call dlv("8")
call dlv("9")
call dlv("10")
call dlv("11")
call dlv("12")
call dlv("PAROIS_DEFORMABLES") 
end sub


Sub dlv(nom As String)
Dim wsdlv As Worksheet

ActiveSheet.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:=nom
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort.SortFields.Add Key:= _
Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("PROGRAMME").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1:CF383").Select
Selection.Copy
Set wsdlv = Sheets.Add(After:=Sheets(Sheets.Count))
wsdlv.Name = "DLV" + nom
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Cette réponse vous a-t-elle aidé ?  
Commenter la réponse de yg_be
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - Modifié par yg_be le 16/06/2017 à 16:39
+1
Utile
11
si j'ai bien deviné, suggestion:
Sub dlv(nom As String, col As Integer)
Dim wsdlv As Worksheet
Dim wsprog As Worksheet
Dim ws As Worksheet
Dim creation As Boolean

creation = True
For Each ws In Sheets
    If ws.Name = "DLV" + nom Then
        Set wsdlv = ws
        wsdlv.Cells.Clear
        creation = False
        Exit For
    End If
Next ws
If creation Then
    Set wsdlv = Sheets.Add(After:=Sheets(Sheets.Count))
    wsdlv.Name = "DLV" + nom
End If
Set wsprog = ActiveWorkbook.Worksheets("PROGRAMME")
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=col, Criteria1:=nom
wsprog.AutoFilter.Sort.SortFields.Clear
wsprog.AutoFilter.Sort.SortFields.Add Key:= _
wsprog.Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With wsprog.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
wsprog.Range("A1:CF383").Copy wsdlv.Range("A1")
Application.CutCopyMode = False
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=col
End Sub

tu peux supprimer majtridlv, et changer ceci:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$A$1:$CI$385")) Is Nothing  Then
    Call TriDLV()
End If
End Sub
Cette réponse vous a-t-elle aidé ?  
JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention > JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 17 juin 2017 à 15:02
J'ai testé avec ton nouveau code - ça me plante l'execution
J'essaie avec LBound/Ubound

Tu as déjà utilisé ces fonctions?
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention > JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 17 juin 2017 à 18:48
tu n'expliques pas vraiment ce que tu essaies de faire, difficile de te conseiller.
si tu souhaites simplement aller jusqu'au bout de ton tableau, tu peux faire plus simplement.
JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention > yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - 19 juin 2017 à 10:27
Bonjour yg_be,
Désolée de répondre si tard, en week-end OFF!
En fait la macro fonctionne à merveille, les maj aussi quand je fais une modif sur le tableau défini ("A1:CF383").
Si je rajoute une ligne en fin de tableau, la macro de maj se lance mais ne prend pas en compte la dernière ligne du tableau ajoutée
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention > JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 19 juin 2017 à 19:33
le plus simple, alors, serait de chercher automatiquement le numéro de la dernière ligne et de l'utiliser à la place de 383.
ainsi, par exemple:
Option Explicit
Sub dlv(nomfeuille As String, col As Integer, critere As String, fintab As Long)
Dim wsdlv As Worksheet
Dim wsprog As Worksheet
Dim ws As Worksheet
Dim creation As Boolean

creation = True
For Each ws In Sheets
    If ws.Name = nomfeuille Then
        Set wsdlv = ws
        wsdlv.Cells.Clear
        creation = False
        Exit For
    End If
Next ws
If creation Then
    Set wsdlv = Sheets.Add(After:=Sheets(Sheets.Count))
    wsdlv.Name = nomfeuille
End If
Set wsprog = ActiveWorkbook.Worksheets("PROGRAMME")
wsprog.Range("$A$1:$CI$" & CStr(fintab)).AutoFilter Field:=col, Criteria1:=critere
wsprog.AutoFilter.Sort.SortFields.Clear
wsprog.AutoFilter.Sort.SortFields.Add Key:= _
wsprog.Range("B1:B" & CStr(fintab)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With wsprog.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
wsprog.Range("A1:CF" & CStr(fintab)).Copy wsdlv.Range("A1")
Application.CutCopyMode = False
wsprog.Range("$A$1:$CI$" & CStr(fintab)).AutoFilter Field:=col
End Sub

Sub TriDLV()
Const sdlv As String = "DLV"
Dim derlig As Long
derlig = Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Call dlv(sdlv & "1", 7, "1", derlig)
Call dlv(sdlv & "2", 7, "2", derlig)
Call dlv(sdlv & "3", 7, "3", derlig)
Call dlv(sdlv & "4", 7, "4", derlig)
Call dlv(sdlv & "5", 7, "5", derlig)
Call dlv(sdlv & "6", 7, "6", derlig)
Call dlv(sdlv & "7", 7, "7", derlig)
Call dlv(sdlv & "8", 7, "8", derlig)
Call dlv(sdlv & "9", 7, "9", derlig)
Call dlv(sdlv & "10", 7, "10", derlig)
Call dlv(sdlv & "11", 7, "11", derlig)
Call dlv(sdlv & "12", 7, "12", derlig)
Call dlv("PAROIS_DEFORMABLES", 28, "PAROIS_DEFORMABLES", derlig)
End Sub

il faudrait changer aussi la fonction "change". je me demande si la feuille programme contient autre chose que le tableau. si il n'y a rien d'autre, ceci suffirait:
Private Sub Worksheet_Change(ByVal Target As Range)
    Call TriDLV
End Sub
JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention > yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - 20 juin 2017 à 10:02
Merci
je teste
Commenter la réponse de yg_be
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - 14 juin 2017 à 21:41
0
Utile
20
Je pense que ton analyse n'est pas correcte: ton soucis vient du fait que tu utilises ActiveSheet sans bien contrôler sa valeur.
je propose donc:
Sub dlv(nom As String)
Dim wsdlv As Worksheet
Dim wsprog As Worksheet

Set wsprog = ActiveWorkbook.Worksheets("PROGRAMME")
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=7, Criteria1:=nom
wsprog.AutoFilter.Sort.SortFields.Clear
wsprog.AutoFilter.Sort.SortFields.Add Key:= _
wsprog.Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With wsprog.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Set wsdlv = Sheets.Add(After:=Sheets(Sheets.Count))
wsdlv.Name = "DLV" + nom
wsprog.Range("A1:CF383").Copy wsdlv.Range("A1")
Application.CutCopyMode = False
End Sub
JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention > yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - 16 juin 2017 à 13:13
question bête surement… il faut une sub tridlv et une sub majtidlv? ou bien majtridlv fait le boulot des deux?
Je me perds un peu
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention > JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 16 juin 2017 à 13:54
pour le moment, il faut les deux.
si cela marche, je peux simplifier et n'en faire qu'une.
JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention > yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention - 16 juin 2017 à 14:23
Sur ta ligne 10 j'ai cette erreur
Erreur d'exécution « 9 »:

L'indice n'appartient pas à la sélection

Pour rappel, voici le code:
Sub TriDLV()
Call dlv("1", 7)
Call dlv("2", 7)
Call dlv("3", 7)
Call dlv("4", 7)
Call dlv("5", 7)
Call dlv("6", 7)
Call dlv("7", 7)
Call dlv("8", 7)
Call dlv("9", 7)
Call dlv("10", 7)
Call dlv("11", 7)
Call dlv("12", 7)
Call dlv("PAROIS_DEFORMABLES", 28)
End Sub

Sub dlv(nom As String, col As Integer, Optional creation As Boolean = True)
Dim wsdlv As Worksheet
Dim wsprog As Worksheet

If creation Then
Set wsdlv = Sheets.Add(After:=Sheets(Sheets.Count))
wsdlv.Name = "DLV" + nom
Else
Set wsdlv = Sheets("DLV" + nom)
wsdlv.Cells.Clear
End If
Set wsprog = ActiveWorkbook.Worksheets("PROGRAMME")
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=col, Criteria1:=nom
wsprog.AutoFilter.Sort.SortFields.Clear
wsprog.AutoFilter.Sort.SortFields.Add Key:= _
wsprog.Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With wsprog.AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
wsprog.Range("A1:CF383").Copy wsdlv.Range("A1")
Application.CutCopyMode = False
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=col
End Sub


Sub majTriDLV()
Call dlv("1", 7, False)
Call dlv("2", 7, False)
Call dlv("3", 7, False)
Call dlv("4", 7, False)
Call dlv("5", 7, False)
Call dlv("6", 7, False)
Call dlv("7", 7, False)
Call dlv("8", 7, False)
Call dlv("9", 7, False)
Call dlv("10", 7, False)
Call dlv("11", 7, False)
Call dlv("12", 7, False)
Call dlv("PAROIS_DEFORMABLES", 28, False)
End Sub
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention > JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 16 juin 2017 à 16:17
c'est quoi la ligne 10? serait-ce:
Set wsdlv = Sheets("DLV" + nom)

j'imagine que cela se passe parce que tu fais des changements dans tes données et que tes onglets DLV n'existent pas encore...
est-ce exact?
si oui, je ferai une autre suggestion bientôt.
yg_be 4130 Messages postés lundi 9 juin 2008Date d'inscriptionContributeurStatut 12 décembre 2017 Dernière intervention > JenSou798312 56 Messages postés mardi 30 mai 2017Date d'inscription 20 juin 2017 Dernière intervention - 15 juin 2017 à 19:03
suggestion pour le message #8 (filtre précédant restant présent):
Sub dlv(nom As String, col As Integer)
Dim wsdlv As Worksheet
Dim wsprog As Worksheet

Set wsprog = ActiveWorkbook.Worksheets("PROGRAMME")
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=col, Criteria1:=nom
wsprog.AutoFilter.Sort.SortFields.Clear
wsprog.AutoFilter.Sort.SortFields.Add Key:= _
wsprog.Range("B1:B385"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With wsprog.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Set wsdlv = Sheets.Add(After:=Sheets(Sheets.Count))
wsdlv.Name = "DLV" + nom
wsprog.Range("A1:CF383").Copy wsdlv.Range("A1")
Application.CutCopyMode = False
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=col
End Sub
Commenter la réponse de yg_be