Trier, copier, coller, annuler la sélection

Le 14/06/2017 à 20:51

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

Le 14/06/2017 à 21:01

Bonjour

Tu devrais joindre ton fichier complet....

Bye !

Le 14/06/2017 à 21:02

Le problème c'est que j'ai des données confidentielles dessus

Pour info, la partie filtrer et trier je l'ai faite grace à l'enregistreur de macro

Le 15/06/2017 à 09:21

Bonjour,

Pour info, pb résolu.

Pour ceux que ça intéresse, voici le code:

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 ParoisDeformables

End Sub

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

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

Rechercher des sujets similaires à "trier copier coller annuler selection"