coper n premieres lignes d'une feuille filtrée

[nemo]

Bonjour
Voici mon code pour filtrer le contenu d'une page selon 2 critères puis trier selon 2 autres critères. La macro fonctionne.

Sub filtri()
'
' trans11 Macro
' Macro enregistrée le 17/11/2006 par IEN60
'

'
'declare var
Dim codest As String
codest = Sheets("commande").Range("C21")
'Sélection feuille
Sheets("test").Select
'Filtre reinitialisé
ActiveSheet.AutoFilterMode = False

Selection.AutoFilter Field:=6, Criteria1:=codest
Selection.AutoFilter Field:=11, Criteria1:="non servi"
Range("A1:K610").Sort Key1:=Range("J2"), Order1:=xlAscending, Key2:=Range _
("H2"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
'
End Sub

Ayant fait apparaitre les enregistrements que je veux copier sur une autre feuille en haut de la table, je souhaitais me servir de la macro suivante pour réaliser cela. Hors cette macro ne tient pas compte du filtre/tri visible à l'écran et va coper les premières lignes de la table non filtrée

Sub transfert()
'
' transfert Macro
' Macro enregistrée le 17/11/2006 par IEN60
'
nb = Sheets("commande").Range("C19")
Dim feuille As String
feuille = Sheets("commande").Range("C21")
Sheets("test").Range("A2:K" & 1 + nb).Copy Destination:=Sheets(feuille).Range("A65536").End(xlUp).Offset(1, 0)
For n = 1 To nb
Sheets("test").Range("K" & 1 + n) = "servi"
Next n
'
End Sub

Quelqu'un a t'il une idée ? Merci à vous !

 

[nemo]

Re : coper n premieres lignes d'une feuille filtrée

Il semblerait que ceci ne permette pas de selectionner les lignes uniquement filtrées
Sheets("test").Range("A2:K" & 1 + nb).Copy

Comment mixer mon script avec cette commande qui devrait le permettre ?
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.Copy

 

[Bebere]

Re : coper n premieres lignes d'une feuille filtrée

bonjour Nemo
ce bout de code pour t'aider

Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData

End Sub

à bientôt

 

[MichelXld]

Re : coper n premieres lignes d'une feuille filtrée

bonjour

tu peux tester

Worksheets("Feuil1").AutoFilter.Range. _
        SpecialCells(xlCellTypeVisible).Copy

Bonne journée
MichelXld

 

[nemo]

Re : coper n premieres lignes d'une feuille filtrée

Hélas Bebere je n'ai pas un niveau suffisant pour décrypter ton code, de plus je doute qu'il ne complique pas inutilement le mien. Je pense que mon code est tout près de fonctionner mais la ligne en bleu m'apporte un message d'erreur "pas de cellule correspondantes"
Help !

Sub transfert2()
'
' transfert2 Macro
' Macro enregistrée le 23/11/2006 par IEN60
'
nb = Sheets("commande").Range("C19")
Dim feuille As String
feuille = Sheets("commande").Range("C21")
Sheets("test").Range("A2:K" & 1 + nb).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(feuille).Range("A65536").End(xlUp).Offset(1, 0)
For n = 1 To nb
Sheets("test").Range("K" & 1 + n) = "servi"
Next n
'
End Sub

 

[nemo]

Re : coper n premieres lignes d'une feuille filtrée

La variable $nb que l'utilisateur saisit dans la cellule C19 de la feuille'commande' définit le nombre de lignes de la table qui doivent être copiées dans la feuille du même nom que la variable $feuille.

C'est pour cela je pense que

Code :

Worksheets("Feuil1").AutoFilter.Range. _
        SpecialCells(xlCellTypeVisible).Copyne

fonctionne pas.
Je veux coller le nombre de lignes contenues dans la variable nb dans l'autre feuille.
J'essaie aussi avec

nb = Sheets("commande").Range("C19")
Dim feuille As String
feuille = Sheets("commande").Range("C21")

For n = 1 To nb
Sheets("test").Range("A2").Rows.Select
Sheets("test").Range("K" & 1 + n) = "servi"
Next n
'
End Sub

Juste pour voir si j'arrive à sélectionner n lignes de la table filtrée. Sans résultat.

 

[Bebere]

Re : coper n premieres lignes d'une feuille filtrée

nemo

Sub CopyFilter()
'by Tom Ogilvy
Dim rng As Range
Dim rng2 As Range
la partie entre if et else c'est une gestion d'erreur ,si rng2 est vide pas de copie
le resize pour enlever la ligne d'entête(1ère ligne)

With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Worksheets("Sheet2").Cells.Clear
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Sheet2").Range("A1")
End If
ActiveSheet.ShowAllData
ou bien tu fais ton copy et ensuite tu effaces ce que tu as de trop
exemple
début=21'si tu veux garder les 20 1ères lignes
fin=Worksheets("Sheet2").range("A65536").end(xlup).row
Worksheets("Sheet2").rows(début & ": & fin).delete

2ème méthode sans copy
set rng= ActiveSheet.AutoFilter.Range
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
plg=rng.value
for i=1 to 20'nbre de lignes que tu veux garder
Worksheets("Sheet2").range("A" & i)=plg(i,1)
next i
End Sub
non garanti sans faute(lol)
à bientôt

 

[Bebere]

Re : coper n premieres lignes d'une feuille filtrée

oups,oubli(mérite une paire de baffes,sale garnement,scrogneugneu!!!) un salut à MichelXld

 

[nemo]

Re : coper n premieres lignes d'une feuille filtrée

Merci bebere pour ton code ; j'apprecie beaucoup ton aide.
Ne penses tu pas cependant que je suis tout pres de la solution avec un code beaucoup plus simple ?
Quel est ton avis ?

 

[papapaul]

Re : coper n premieres lignes d'une feuille filtrée

Petit truc qui parle de filtres,

Regardez pas les codes, j'ai honte.
C'tait mes tout début en USF, pour m'entraîner.

Coller une grosse base et faire tous les filtres qu'on veut.
Après je me suis lâcher

Pardon aux puristes, j'ai fait des progrès depuis.

Vive xld