Discussion :

[Kestion100]

Bonjour,
Je pense ne pas être loin de la solution de mon problème mais coince.

Je cherche à sélectionner toutes les lignes qui ont une valeur donnée dans la colonne E (M ou O par exemple), la copier, ouvrir un nouveau classeur excel, coller les lignes enregistrer puis enfin fermer.

Pour l'instant, je n'arrive qu'à copier/coller qu'une seule ligne


je joins un fichier et colle ici mon code (je ne connais plus la manip)

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
Sub SELECTIONNECOPIEDANSNOUVEAUFICHIER()
Selection.AutoFilter Field:=5, Criteria1:="M"
For i = [E65000].End(xlUp).Row To 2 Step -1
    If Cells(i, 5) = "M" Then Rows(i).Select
 
 
Next i
 
Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Bureau\Classeur4.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close
 
Selection.AutoFilter Field:=5, Criteria1:="O"
For i = [E65000].End(xlUp).Row To 2 Step -1
If Cells(i, 5) = "O" Then Rows(i).Select
 
 
Next i
 
Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Bureau\Classeur5.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close
End Sub

[PMO2017]

Bonjour,

Essayez avec votre code modifié

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
Sub SELECTIONNECOPIEDANSNOUVEAUFICHIER()
Dim R As Range
For i = [E65000].End(xlUp).Row To 2 Step -1
  If Cells(i, 5) = "M" Then
    If R Is Nothing Then
      Set R = Rows(i)
    Else
      Set R = Application.Union(R, Rows(i))
    End If
  End If
Next i
R.Copy
 
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Bureau\Classeur4.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close False
 
 
Set R = Nothing
For i = [E65000].End(xlUp).Row To 2 Step -1
  If Cells(i, 5) = "O" Then
    If R Is Nothing Then
      Set R = Rows(i)
    Else
      Set R = Application.Union(R, Rows(i))
    End If
  End If
Next i
R.Copy
 
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Bureau\Classeur5.xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
    ActiveWindow.Close False
 
Application.CutCopyMode = False
End Sub