Discussion :

[Chris38190]

Bonjour à Tous,
Je suis novice dans la programmation VBA. J'utilise une version excel :Office 365 MSO (16.011328.20620) 32 bits
l'objectif de mon programme est de copier à partir de la feuille "Liste I-O" des lignes de façon automatique suivant des sélections prédéfinies .
étape 1 : copier l'entête de "Liste I-O" vers "new_60kV_ver005", OK
étape 2 : faire des sélections suivant des critères et copier le résultat dans "new_60KV_ver005"
PB : A chaque fois que je copie mes sélections, j'écrase la copie précédente.

Merci de m'expliquer comment gérer le remplissage de "new_60KV_ver005" au fur et à mesure que je copie des lignes dans "new_60kV_ver005.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Public Sub Création_new_60KV_ver005()
'
' Création_new_60KV_ver005 Macro
'
 
Dim NbLignes As Integer
 
    Sheets("Liste I-O").Select
    Rows("1").Select
    Selection.Copy
    Sheets("new_60KV_ver005").Select
     Rows("1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
 
    Sheets("Liste I-O").Select
    NbLignes = Range("B" & Rows.Count).End(xlUp).Row
 
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=10
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=10, Criteria1:= _
        "QM02"
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=6
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=6, Criteria1:="=*OUV" _
        , Operator:=xlOr, Criteria2:="=*FER"
 
 
    ActiveSheet.Range("$A$2:$X$" & NbLignes).SpecialCells(xlCellTypeVisible).Copy
 
    Sheets("new_60KV_ver005").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    Sheets("Liste I-O").Select
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=10
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=10, Criteria1:= _
        "QM01"
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=6
    ActiveSheet.Range("$A$2:$X$" & NbLignes).AutoFilter Field:=6, Criteria1:="=*OUV" _
        , Operator:=xlOr, Criteria2:="=*FER"
 
    ActiveSheet.Range("$A$2:$X$" & NbLignes).SpecialCells(xlCellTypeVisible).Copy
 
    Sheets("new_60KV_ver005").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
    End Sub

Merci d'avance pour votre aide et bonne journée

[Menhir]

étape 2 : faire des sélections suivant des critères et copier le résultat dans "new_60KV_ver005"
PB : A chaque fois que je copie mes sélections, j'écrase la copie précédente.

Parce que tu n'indiques pas ta ligne de destination.

Petit conseil : évite les Select/Selection

Ton code retouché :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Public Sub Création_new_60KV_ver005()
    Dim NbLignes As Long, LDest As Long
    Dim WS_From As Worksheet
    Dim WS_To As Worksheet
 
    Set WS_From = Sheets("Liste I-O")
    Set WS_To = Sheets("new_60KV_ver005")
 
    WS_From.Rows("1").Copy WS_To.Cells(1, 1)
 
    NbLignes = WS_From.Range("B" & Rows.Count).End(xlUp).Row
 
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=10
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=10, Criteria1:= "QM02"
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=6
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=6, Criteria1:="=*OUV", Operator:=xlOr, Criteria2:="=*FER"
 
    LDest = WS_To.Range("B" & Rows.Count).End(xlUp).Row + 1
    WS_From.Range("A2:X" & NbLignes).SpecialCells(xlCellTypeVisible).Copy WS_To.Cells(LDest, 1)
    WS_From.Range("A2:X" & NbLignes).AutoFilter
 
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=10
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=10, Criteria1:= "QM01"
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=6
    WS_From.Range("A2:X" & NbLignes).AutoFilter Field:=6, Criteria1:="=*OUV", Operator:=xlOr, Criteria2:="=*FER"
 
    LDest = WS_To.Range("B" & Rows.Count).End(xlUp).Row + 1
    WS_From.Range("A2:X" & NbLignes).SpecialCells(xlCellTypeVisible).Copy WS_To.Cells(LDest, 1)
    WS_From.Range("A2:X" & NbLignes).AutoFilter
 
End Sub

[Chris38190]

Merci pour votre aide