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

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention -
JenSou798312 Messages postés 57 Date d'inscription Statut Membre 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

A voir également:

Filtrer, trier, copier, coller, annuler la sélection
Excel trier par ordre croissant chiffre - Guide
Historique copier coller - Guide
Copier coller pdf - Guide
Copier-coller - Accueil - Informatique
Style d'écriture a copier coller - Guide

3 réponses

Réponse 1 / 3

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

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

Réponse 2 / 3

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

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

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention

la mise à jour fonctionne,
la création des feuilles fonctionne sauf pour parois déformables

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584

je pense comprendre le soucis.
suggestion:

Sub dlv(nomfeuille As String, col As Integer, critere As String)
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$385").AutoFilter Field:=col, Criteria1:=critere
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 TriDLV()
Const sdlv As String = "DLV"

Call dlv(sdlv & "1", 7, "1")
Call dlv(sdlv & "2", 7, "2")
Call dlv(sdlv & "3", 7, "3")
Call dlv(sdlv & "4", 7, "4")
Call dlv(sdlv & "5", 7, "5")
Call dlv(sdlv & "6", 7, "6")
Call dlv(sdlv & "7", 7, "7")
Call dlv(sdlv & "8", 7, "8")
Call dlv(sdlv & "9", 7, "9")
Call dlv(sdlv & "10", 7, "10")
Call dlv(sdlv & "11", 7, "11")
Call dlv(sdlv & "12", 7, "12")
Call dlv("PAROIS_DEFORMABLES", 28, "PAROIS_DEFORMABLES")
End Sub

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention > yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention

Tout fonctionne nickel
dernière question, si je veux ajouter une ligne en fin de tableau (en fin d'année, je peux avoir des lignes en plus), j'ai vérifié, ça ne prends pas les motif à ce niveau là.
Est ce qu'il ne faudrait pas définir la plage de sélection avec Lbound et Ubound?

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584 > JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention

peut-être ainsi?

Sub dlv(nomfeuille As String, col As Integer, critere As String)
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:$CI").AutoFilter Field:=col, Criteria1:=critere
wsprog.AutoFilter.Sort.SortFields.Clear
wsprog.AutoFilter.Sort.SortFields.Add Key:= _
wsprog.Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
:=xlSortNormal
With wsprog.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
wsprog.Range("A:CF").Copy wsdlv.Range("A1")
Application.CutCopyMode = False
wsprog.Range("$A:$CI").AutoFilter Field:=col
End Sub

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention > yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention

je pensais plutôt rajouter dans les variables (BDD As Variant)
et
Dim n As Long
Dim RefPos As Long
For n = Lbound(BDD) To Ubound(BDD)
RefPos = n
etc...

Réponse 3 / 3

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

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 Messages postés 57 Date d'inscription Statut Membre Dernière intervention

Ce code me crée qu'une feuille DLV après PROGRAMME et m'efface le contenu de la colonne 7.
En fait il a pris que les cellules vides, ma selection de filtre est toujours présente dans PROGRAMME après l'exécution de ta macro

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention > JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention

Au temps pour moi ça fonctionne impec!!!
Merci beaucoup

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention > JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention

Petite question,
Pour la dernière condition de tri (Parois Deformable), mon filtre n'est pas sur la colonne 7 mais 28.
J'ai essayé d'adapter ton code pour qu'il aille chercher la bonne info pour la dernière condition, et ça ne fonctionne pas :-/
Est ce que je peux abuser de ton aide encore une fois?
J'ai modifié Call dlv("PAROIS_DEFORMABLES") par Call ParoisDeformables()
et j'ai rajouté une Sub ParoisDeformables() avec ton code modifié…

Sub ParoisDeformables()
Dim wsdlv As Worksheet
Dim wsprog As Worksheet

Set wsprog = ActiveWorkbook.Worksheets("PROGRAMME")
wsprog.Range("$A$1:$CI$385").AutoFilter Field:=28, Criteria1:="PAROIS DEFORMABLES"
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 = "PAROIS_DEFORMABLES"
wsprog.Range("A1:CF383").Copy wsdlv.Range("A1")
Application.CutCopyMode = False
End Sub

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention 1 584

je suggère plutôt:

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
End Sub

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

JenSou798312 Messages postés 57 Date d'inscription Statut Membre Dernière intervention > yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention

re,

les données parois réformables ne s'incrementent pas dans la nouvelle feuille

Discussions similaires

dessin avec symbole clavier

Arobase

dessin au clavier cannabis

Votre réponse

Discussions similaires