Discussion :

[huître]

bonjour j'ai une procédure:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub formule()
 
 
    Range("AF1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=32, Criteria1:="1"
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    selection.copy
 
End Sub

donc cette formule applique un filtre et me copie le contenu.

j'aimerai bien copier coller sur autre nouvelle feuille qui ecrase la feuille d'origine (celle ou je fais la copie) ou bien remplacer le contenu de la feuille d'origine par ce qui à été copié

voila merci d'avance

en faite c'est la seule alternative pour que ca soit pas du tout long à charger mais le problème c'est que je suis incapable d'exporter ce que j'ai copier sur une autre feuille ou de remplacer la totalité de la feuille initiale par le contenu du filtre voila
merci d'avance

[MarcelG]

Bonjour à toi, Bonjour le Forum,

Sans un seul

Code :

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

Select

qui n'ajoute rien, je peux te proposer

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
Public Sub essai()
'Effacer la Feuille 2
Worksheets("Feuil2").Cells.ClearContents
'Mise à jour de l'écran non activée
Application.ScreenUpdating = False
'Action sur la Feuille1
With Worksheets("Feuil1")
    'Pour afficher toutes les occurences
     If .FilterMode = True Then .ShowAllData
   'définition de la cellule en dernière ligne et dernière colonne
    derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
    dercol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    With .Range(.Range("A1"), .Cells(derlign, dercol))
            'le filtre selon le critère choisi
            .AutoFilter Field:=32, Criteria1:="1"
            'copie des seules cellules affichées, donc après filtre
            .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets("Feuil2").Range("A1")
    End With
End With
'mode copy non activé
Application.CutCopyMode = False
End Sub

Reprends toutes les lignes de cette proposition de code, et reviens si nécessaire pour d'éventuelles précisions.

[huître]

ben visiblement j'ai suivis tes conseils à la lettre et rien n'y fait malheureusement toujours le mm problème

[MarcelG]

Quel problème ?

Peux-tu préciser sur quelle ligne de code le bug se situe. Et quel est le message d'erreur.

A la limite, peux-tu mettre ton fichier en pièce jointe
- en le simplifiant à une seule feuille
- en conservant le code
- en remplaçant les données confidentielles (1 seul caractère suffit)
- en précisant ton critère (valeur et colonne)

On va y arriver.

[huître]

alors ça bug dans cette ligne

Code :

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

1
2
Sheets("macopie").Activate
Sheets("macopie").Range(Cells(1, 1), Cells(UBound(tbl, 2), UBound(tbl, 1))) = Application.WorksheetFunction.Transpose(tbl())

plus exactement la derniere

[MarcelG]

Bonjour Huitre, Bonjour le Forum

J'ai l'impression que ton tableau n''est pas alimenté.

Mets ta dernière ligne de code - celle qui buggue - en commentaires, et insère au-dessus.

Code :

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

1
2
Debug.Print UBound(tbl, 1)
Debug.Print UBound(tbl, 2)

Et fais part des résultats affichés dans la fenêtre Exécution

(Pour afficher la fenêtre Exécution : CTRL + G)

Il doit y avoir homogénéité entre la colonne de recherche et son numéro

AG ==> 33
AF ==> 32

De plus un fichier joint, même simplifié en 1 seule feuille, serait bienvenu.

[huître]

alors je pense qu'il est plus judicieux d'envoyer le fichier j'ai inseré un commentaire à la première page visiblement rien n ' y fait

[huître]

je vais essayer d'exporter la feuille dans le classeur fichierépuré

[huître]

alors merci

ta formule est geniale en terme de gain de temps

parcontre j'ai crée un algorithme mais je n'arrive pas à le mettre sous forme de tableau

donc le voila:

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
Sub compteur()
Dim sh As Worksheet
    Dim Ligne As Long
    For Each sh In Worksheets(Array("AAR35", "AAR", "RST", "PCH", "EXP DIF"))
        Ligne = sh.Range("ae" & sh.Rows.Count).End(xlUp).Row
    For i = 2 To Ligne
    For j = 4 To 27
    For k = 2 To 6
    If Cells(k, 3) = sh.Name Then
        If Cells(1, j) = sh.Cells(i, 32) Then
        Cells(k, j) = Cells(k, j) + 1
        End If
    End If
    Next k
    Next j
    Next i
    Next sh
End Sub

le traitement est super long est ce qu'il existe une manière de gagner du temps ?