copier/coller sur un autre feuille

**huître** · 06/05/2011, 14h13

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** · 09/05/2011, 04h35

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** · 09/05/2011, 14h22

merci ca fonctionne

je vais être un peu chiant mais est ce qu'il est possible de faire tout ce processus dans une seule et même feuille??

**MarcelG** · 09/05/2011, 14h39

Re-bonjour,

Ce qui est génant dans ce cas, c'est que par définition un filtre te masque les lignes ne correspondant pas à ton critère.

Il te faut donc changer de méthode en n'utilisant pas le filtre.

Cette méthode consiste à alimenter une variable Tableau avec les méthodes

Code :

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

.Find

et

Code :

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

.FindNext

Ce tableau, à 2 dimensions, serait alimenté cellule par cellule, puis collé dans ta feuille par transposition

**huître** · 09/05/2011, 14h43

par exemple j'ai 5 feuilles,

est ce que c'est possible de dire

pour les 5 feuilles tu appliques ce filtre
tu copie le resultat des 5 filtres et tu les colles (deplaces) sur 5 nouvelles feuilles
tu me supprimes les 5 feuilles initiales et les nouvelles feuilles hérite de l'ancien nom (nom des feuilles supprimé)

**MarcelG** · 09/05/2011, 14h53

Hum! Cette méthode est un peu triviale.

Par contre, tu peux balayer les cellules de ta colonne "filtrée" et supprimer la ligne entière de chaque cellule ne répondant pas au critère.

Reviens si cette méthode te convient.

**huître** · 09/05/2011, 15h03

salut merci pour la réponse j'ai essayer et apparemment ça fonctionne correctement il n'y a aucun soucis avec le masque on revanche ce que je cherche en se moment c'est plutot de généraliser la formule sur plusieurs feuilles

**MarcelG** · 09/05/2011, 15h34

Si tu souhaites associer à chaque feuille origine, une feuille destination.

En en-tête de module pour débuter tes tableaux à l'indice 1 (option)

Code :

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

Option Base 1

Ici Feuil1 est copiée dans Feuil3 et Feuil2 est copiée dans Feuil4

A adapter

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
Public Sub Monessai()
Dim i As Integer
Dim Tablfeuil_orig As Variant, Tablfeuil_dest As Variant
'Mise à jour de l'écran non activée
Application.ScreenUpdating = False
 
Tablfeuil_orig = Array("Feuil1", "Feuil3")
Tablfeuil_dest = Array("Feuil2", "Feuil4")
 
For i = 1 To 2
        Worksheets(Tablfeuil_dest(i)).Cells.ClearContents
        'Action sur la Feuille1
        With Worksheets(Tablfeuil_orig(i))
                 '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:=2, Criteria1:="1"
                         'copie des seules cellules affichées, donc après filtre
                         .SpecialCells(xlCellTypeVisible).Copy Destination:=Worksheets(Tablfeuil_dest(i)).Range("A1")
                 End With
        End With
Next i
'mode copy non activé
Application.CutCopyMode = False
End Sub

Plouf! Plouf!

Ici Feuil1 est copiée dans Feuil3 et Feuil2 est copiée dans Feuil4

Il faut lire

Ici Feuil1 est copiée dans Feuil2 et Feuil3 est copiée dans Feuil4

**huître** · 09/05/2011, 15h46

merci pour ton code je vais l'essayer

elle parait certes trivial mais c'est la seule maniere pour gagner enormement de temps
étant donné que les feuilles contiennent enormement de ligne , la suppression des lignes serait un processus très long (au moins 7 minutes)

j'ai essayé un tas de code de suppression de ligne et ça reste toujours trop long donc l'idéal serait non pas de supprimer les lignes mais plutot de les exporter et finalement supprimer la page initiale

**MarcelG** · 09/05/2011, 15h53

Pas d'accord, Huitre.

Travailler sur grandes données et maximiser le temps de traitement implique presque toujours l'utilisation des tableaux (gain de temps de l'ordre de 99% si ce n'est plus).

**huître** · 09/05/2011, 16h03

Ah d'accord
donc ca voudrait dire que je pourrais supprimer toutes les lignes en 10 seconde

mais je vois pas comment je peux faire avec des tableaux??

en revanche je peux t'envoyer une serie de codes pour le dedoublonnage et l'adapter de maniere à minimiser la durée du traitement

1er code

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub clean()
 
Dim derlg  As Long
Dim sh As Worksheet
For Each sh In Worksheets(Array("EXP DIF", "AAR35", "AAR", "PCH", "RST"))
derlg = sh.Range("AE" & Rows.Count).End(xlUp).Row
sh.Range("AF1").FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],0,1)"
sh.Range("AF1").AutoFill Destination:=sh.Range("AF1:AF" & derlg), Type:=xlFillDefault
sh.Range("AF1:AF" & derlg) = sh.Range("AF1:AF" & derlg).Value
sh.Range("AE1:AF1").AutoFilter
sh.Range("$AE$1:$AF$" & derlg).AutoFilter Field:=2, Criteria1:="0"
sh.Cells.SpecialCells(xlCellTypeVisible).Delete
Next sh
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Cleaner()
    Dim sh As Worksheet
    Dim Ligne As Long
    For Each sh In Worksheets(Array("AAR35", "AAR", "RST"))
        Ligne = sh.Range("af" & sh.Rows.Count).End(xlUp).Row
        Do Until Ligne = 1
            If Application.CountIf(sh.Columns("AF:AF"), sh.Range("af" & Ligne).Value) > 1 Then
                sh.Range("a" & Ligne).EntireRow.Delete
            End If
            Ligne = Ligne - 1
        Loop
    Next
End Sub

**MarcelG** · 09/05/2011, 16h29

Huitre,

Tu peux adapter ce code lui-même adapté d'un autre code, de Theze.

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
49
50
51
52
Sub ChercherValeur()
 
    Dim Tbl()
    Dim Plage As Range
    Dim Cel As Range
    Dim LaValeur As Integer
    Dim Adr As String
    Dim I As Integer
 
    'date cherchée (à adapter)
    LaValeur = 1
 
    'plage où s'effectue la recherche de date (colonne A)
    Set dercel = Cells(Rows.Count, 32).End(xlUp)
    Set Plage = Range("AG2:AG" & derlign)
 
    'recherche la valeur
    Set Cel = Plage.Find(LaValeur, LookIn:=xlValues)
 
    'si trouvé
    If Not Cel Is Nothing Then
 
        'mémorise l'adresse de la 1ère cellule
        Adr = Cel.Address
 
        'boucle pour récupérer toutes les dates
        'et stocke les valeurs des colonnes A à D
        'dans un tableau
        Do
 
            I = I + 1
 
            ReDim Preserve Tbl(1 To 32, 1 To I)
 
            For j = 1 To 32
 
                    Tbl(j, I) = Cel.Offset(0, 32 - j)
 
            Next j
 
            Set Cel = Plage.FindNext(Cel)
 
        Loop While Adr <> Cel.Address
 
    End If
 
    'colle le résultat dans la feuille "macopie"
    Sheets("macopie").Range(Cells(1, 1), Cells(UBound(Tbl, 2), UBound(Tbl, 1))) _
    = Application.WorksheetFunction.Transpose(Tbl())
 
 
End Sub

Ici, la boucle en j récupère toutes les valeurs à gauche de la cellule répondant au critère et se trouvant en colonne 32.

**huître** · 09/05/2011, 16h54

j'ai un soucis avec la formule je ne sais pas à quoi c'est due

donc visiblement le debogage me surligne la derniere ligne de ce code

Code :

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

1
2
3
'plage où s'effectue la recherche de date (colonne A)
    Set dercel = Cells(Rows.Count, 32).End(xlUp)
    Set Plage = Range("AG2:AG" & derlign)

donc je l'ai adapter

Code :

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

1
2
3
'plage où s'effectue la recherche de date (AF)
    Set dercel = Cells(Rows.Count, 32).End(xlUp)
    Set Plage = Range("AF2:AF" & dercel)

je ne vois vraiment pas à quoi c'est due

**MarcelG** · 09/05/2011, 17h45

Modifications

1 -

Code :

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

dercel = Cells(Rows.Count, 32).End(xlUp).Row

2 - D'autre part, il te faut adapter le nombre 32 et considérer la colonne de ton critère (Ex :Si AF, alors remplacer 32 par 31)

3 - De plus, remplace 32-j par j-32 dans la boucle, car cellules à gauche.

4 - Enfin, insère

Code :

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

Sheets("macopie").Activate

en avant dernière ligne, avant la méthode transpose

A plus.

**huître** · 09/05/2011, 21h35

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

**MarcelG** · 09/05/2011, 22h35

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** · 10/05/2011, 09h45

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** · 10/05/2011, 10h10

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** · 10/05/2011, 11h33

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

**MarcelG** · 10/05/2011, 12h43

Salut,

Voici le fichier - en pièce jointe - avec ce code qui est effectif sur la feuille la plus complète.

J'attire ton attention sur le temps de réalisation de la procédure.

Pour traiter 2243 * 32 = 71808 cellules

Temps de traitement : 2 secondes

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
Sub cherchervaleur()
Dim tbl()
Dim plage As Range
Dim cel As Range
Dim lavaleur As Integer
Dim adr As String
Dim I As Integer
 
 
t1 = Timer
 
Application.ScreenUpdating = False
 
With Sheets("YYY")
 
        lavaleur = 1
        dercel = .Cells(Rows.Count, 32).End(xlUp).Row
        Set plage = .Range("AF2:AF" & dercel)
        Set cel = plage.Find(lavaleur, LookIn:=xlValues)
        If Not cel Is Nothing Then
 
                adr = cel.Address
                Do
 
                        I = I + 1
                        ReDim Preserve tbl(1 To 32, 1 To I)
                        For j = 1 To 32
                        tbl(j, I) = cel.Offset(0, j - 32)
                        Next j
                        Set cel = plage.FindNext(cel)
 
                Loop While adr <> cel.Address
 
        End If
 
End With
 
With Sheets("macopie")
        .Activate
         derlign = .Cells(.Rows.Count, 1).End(xlUp).Row
         .Rows("2:" & derlign).ClearContents
        .Range(Cells(1, 1), Cells(UBound(tbl, 2), UBound(tbl, 1))).Offset(1, 0) = Application.WorksheetFunction.Transpose(tbl())
End With
 
Debug.Print Timer - t1 & " secondes de traitement"
 
End Sub