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:

Filtrer, trier, copier, coller, annuler la sélection
Copier coller pdf - Guide
Copier une vidéo youtube - Guide
Super copier - Télécharger - Gestion de fichiers
Copier coller formule excel sans décalage ✓ - Forum Bureautique
Dessin sms copier coller - Forum Jeux vidéo

3 réponses

Réponse 1 / 3

yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
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

Réponse 2 / 3

yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
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

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

yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
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

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 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 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?

yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471 > 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

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 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
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

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

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

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 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
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

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

re,

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

Discussions similaires

Dessiner avec son clavier et avec des lettres

"L'indice n'appartient à la sélection" + VBA

Comment faire le signe de croix (chrétiens) ?

dessin au clavier cannabis

Comment faire le symbole coeur vide/coeur blanc

Discussions similaires

Newsletters