Sujet Précédent Sujet Suivant

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

Fermé
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 - 14 juin 2017 à 20:55
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 - 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

A voir également:

3 réponses

Réponse 1 / 3
yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024 Ambassadeur 1 554
14 juin 2017 à 21:22
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
1
Réponse 2 / 3
yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024 Ambassadeur 1 554
Modifié le 16 juin 2017 à 16:39
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
1
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018
16 juin 2017 à 17:40
la mise à jour fonctionne,
la création des feuilles fonctionne sauf pour parois déformables
0
yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024 1 554
Modifié le 16 juin 2017 à 22:21
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
0
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 > yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024
17 juin 2017 à 13:13
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?
0
yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024 1 554 > JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018
17 juin 2017 à 13:27
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
0
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 > yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024
17 juin 2017 à 13:50
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...
0
Réponse 3 / 3
yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024 Ambassadeur 1 554
14 juin 2017 à 21:41
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
0
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018
15 juin 2017 à 08:51
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
0
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 > JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018
15 juin 2017 à 08:58
Au temps pour moi ça fonctionne impec!!!
Merci beaucoup
0
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 > JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018
Modifié le 15 juin 2017 à 09:18
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
0
yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024 1 554
15 juin 2017 à 14:30
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

et 
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
0
JenSou798312 Messages postés 57 Date d'inscription mardi 30 mai 2017 Statut Membre Dernière intervention 3 mars 2018 > yg_be Messages postés 23352 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 novembre 2024
15 juin 2017 à 17:02
re,

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

Discussions similaires

"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Comment faire le signe de croix (chrétiens) ?
Chachaba -
BoeufDoux20 -

15 réponses
dessin au clavier cannabis
val2t1 -
Mamaaaa18 -

10 réponses
Déplacer un dessin par copier coller
Peter -
Peter -

2 réponses
Comment retrouver le presse papier sur iPhone ?
Slilluu -
Ascaris -

6 réponses