Coller Valeur suite à un filtrage

Version imprimable

Bonjour à tous,
J'ai un souci, je vais tâcher d'être le plus clair possible ( ce qui n'est pas mon fort ^^ )
Contexte :
J'ai un gros (très gros fichier) avec une grosse quantité de formules.
C'est un fichier de suivi de production on peut dire, avec pour chaque ligne une production.
Dans une colonne on affiche l'état de celle-ci. ( en cours, attente x, Terminé )
L'idée c'est que pour alléger ce fichier je souhaite que les lignes où la production est terminé (4500+) passent de formule à juste la valeur ( copier / coller valeur ) .
Manuellement je n'y arrive pas car j'ai une erreur comme quoi la taille et le format des cellules est différent et ayant +4500 ligne à copier / coller valeur je souhaite utiliser une macro.
L'idée de la macro que je souhaite créer est celle-ci :
1- Filtrer la colonne Z ( état prod )
2- copier / coller valeur les lignes visibles 1 à 1 jusque la fin ( ne pouvant pas copier / coller valeur la totalité des lignes visibles d'une traite..)

Pour le moment j'arrive à filtrer sans soucis, mais j'ai du mal à faire dire au VBA d’exécuter une action sur chaque ligne visible une à une (copier / coller valeur )
voici mon code :
Code:

1 2 3 4 5 6 7 Sub Macro1() Dim DerLig As Long Application.ScreenUpdating = False DerLig = Range("A" & Rows.Count).End(xlUp).Row ActiveSheet.Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:= "Terminé" End Sub
Pour le point 2 j'ai fait plusieurs essai mais je bloque..
Pouvez vous me venir en aide ? :)
Merci d'avance.

Bonjour,

Quel est le résultat affiché avec ce code :

Code:

1
2
3
4
5
6
7
8
Sub Macro1()
Dim DerLig As Long, Rng As Range
DerLig = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:= "Terminé"
On Error Resume Next
Set Rng = ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeVisible)
MsgBox Rng.Address
End Sub

Si cela fonctionne comme tu veux, tu pourras essayer ce code sur une copie réduite de ton fichier :

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub mlkezfg()
Dim DerLig As Long, Rng As Range, A As Range
DerLig = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:= "Terminé"
On Error Resume Next
Set Rng = ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeVisible)
For Each A In Rng.Areas
    resultat = resultat & vbCrLf & A.Address
Next
MsgBox resultat
End Sub

22/07/2020, 14h15
Phil Free

Bonjour,

Citation:

Envoyé par Autair

Manuellement je n'y arrive pas car j'ai une erreur comme quoi la taille et le format des cellules est différent et ayant +4500 ligne à copier / coller valeur je souhaite utiliser une macro.

oh ! n'y aurait-t'il pas des cellules fusionnées dans ton tableau ?

si oui faire une macro pour résoudre le probleme sans en tenir compte le problème persistera.

Merci pijaku !
c'est le résultat attendu en effet :ccool:
Et du coup pour appliquer ma formule ( à savoir pastevalues )je l'intègre où et comment ? désolé je débute en vba ^^
je tente dès truc du genre
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Macro2() ' ' Macro2 Macro ' ' Dim DerLig As Long, Rng As Range, A As Range DerLig = Range("A" & Rows.Count).End(xlUp).Row ActiveSheet.Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:="Terminé" On Error Resume Next Set Rng = ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeVisible) For Each A In Rng.Areas resultat = resultat & vbCrLf & A.Address Range("resultat").PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next End Sub
mais je pense pas que ça fonctionne comme cela..
un dernier petit coup de pouce ? ^^

22/07/2020, 14h56
Autair

Citation:

Envoyé par Phil Free

Bonjour,

oh ! n'y aurait-t'il pas des cellules fusionnées dans ton tableau ?

si oui faire une macro pour résoudre le probleme sans en tenir compte le problème persistera.

Merci pour ta réponse phil, non je n'ai pas de cellules fusionnées ( du moins à ma connaissance ) c'est un gros fichier du 10k+ ligne ^^

Pour faire un Coller, il faut d'abord un Copier.
Non?

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Macro2()
Dim DerLig As Long, Rng As Range, A As Range
DerLig = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:="Terminé"
On Error Resume Next
Set Rng = ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeVisible)
For Each A In Rng.Areas
    Range(A.Address).Copy                                       '***********************************************COPIER
    Range(A.Address).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False '***COLLER
Next
End Sub

Après cela, ne restera qu'à affecter cette procédure à la feuille, au lieu de ActiveSheet, du style :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro2()
Dim DerLig As Long, Rng As Range, A As Range
 
  With Sheets("Feuil1")               '******************* A ADAPTER : le nom de la feuille concernée
     DerLig = .Range("A" & Rows.Count).End(xlUp).Row
     .Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:="Terminé"
     On Error Resume Next
     Set Rng = .UsedRange.Cells.SpecialCells(xlCellTypeVisible)
     For Each A In Rng.Areas
         .Range(A.Address).Copy                                       '***********************************************COPIER
         .Range(A.Address).PasteSpecial xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False '***COLLER
     Next
  End With
End Sub

Finalement, il restera encore à tester si le filtre par "terminé" a envoyé des résultats ou pas...
Tu dis si intéressé...

EDIT : J'ai également un doute sur la plage à trier...
Me demande si cela ne serait pas mieux de mettre toutes les colonnes dans le Range, par exemple :
à la place de :

Code:

.Range("Z2:Z" & DerLig).AutoFilter Field:=26, Criteria1:="Terminé"

mettre :

Code:

.Range("A2:BF" & DerLig).AutoFilter Field:=26, Criteria1:="Terminé"

25/07/2020, 04h20
Alex020181

1 pièce(s) jointe(s)

Bonjour,

En PJ un tableau de 9 000 lignes sur 25 colonnes ne contenant que des formules. La colonne "Z" contient les statuts de suivi.
Tu as un bouton pour lancer le code.

Sur ces 9 000 lignes il met, sur mon PC, 1 seconde pour traiter les 1 800 lignes en statut "Terminé".

Pour info et afin de faciliter l'utilisation j'ai codé afin que la casse ne soit pas importante et qu'il prenne également en compte le statut "Termine" (sans l'accent). On ne sait jamais...

Teste et dis nous.