Code imcomplet

Fermé
VDB.57 - 1 juil. 2016 à 12:05
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 - 2 juil. 2016 à 07:36
Bonjour à vous les référents,

Actuellement j’ai 3 colonnes E,F,G . les cellules de ces colonnes contiennent : des formules, des celllules vides et des doublons.
Je veux copier jusqu’à la dernière cellule vide de ces colonnes E,F,G les valeurs des cellules sans doublon et sans cellule vide et les copier respectivement en colonne I,K et M.

J’ai fait quelque chose (voir code joins) qui ne fonctionne pas correctement, j’ai encore des cellules vides et des doublons qui remontent.
Merci par avance pour aide précieuse.


Private Sub UserForm_Initialize()
Range("E1:E6000").Select
Selection.AutoFilter
ActiveSheet.Range("E1:E200").AutoFilter Field:=1, Criteria1:="<>"
Range("E1:E6000").Select
Selection.Copy
Range("I1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter

Range("F1:F6000").Select
Selection.AutoFilter
ActiveSheet.Range("F1:F200").AutoFilter Field:=1, Criteria1:="<>"
Range("F1:F6000").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter

Range("g1:g6000").Select
Selection.AutoFilter
ActiveSheet.Range("g1:g200").AutoFilter Field:=1, Criteria1:="<>"
Range("g1:g6000").Select
Selection.Copy
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter


Range("A1").Select
A voir également:

4 réponses

f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
Modifié par f894009 le 1/07/2016 à 14:42
Bonjour,

pourquoi
Range("E1:E6000").Select

alors que
ActiveSheet.Range("E1:E200").AutoFilter Field:=1, Criteria1:="<>" 


un exemple de traitement:
copie
suppression doublons
suppression cellules vide

Sub test()
    Application.ScreenUpdating = False
    With Worksheets("feuil1")
        derlig = .Range("E" & Rows.Count).End(xlUp).Row
        .Range("E1:E" & derlig).Copy .Range("I1").Resize(derlig)
        .Range("I1").Resize(derlig).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("I1").Resize(derlig).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        
        derlig = .Range("F" & Rows.Count).End(xlUp).Row
        .Range("F1:F" & derlig).Copy .Range("K1").Resize(derlig)
        .Range("K1").Resize(derlig).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("K1").Resize(derlig).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        
        derlig = .Range("G" & Rows.Count).End(xlUp).Row
        .Range("G1:G" & derlig).Copy .Range("M1").Resize(derlig)
        .Range("M1").Resize(derlig).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("M1").Resize(derlig).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End With
    Application.ScreenUpdating = True
End Sub
0
Avant tout merci pour ta réponse,

Concernant ta question ça n'est 2OO mais 6000 que je voulais mettre dans Range("E1:E200").

Ton code est parfait seul HIC il me remonte les formules au lieu des valeurs ?

Merci pour ton aide
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
Modifié par f894009 le 1/07/2016 à 16:38
Re,

Fallait le dire que se sont des cellules avec formule !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

je reprends le code

A+

copie valeurs
Sub test()
    'Application.ScreenUpdating = False
    With Worksheets("feuil1")
        derlig = .Range("E" & Rows.Count).End(xlUp).Row
        .Range("I1").Resize(derlig) = .Range("E1:E" & derlig).Value
        .Range("I1").Resize(derlig).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("I1").Resize(derlig).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        
        derlig = .Range("F" & Rows.Count).End(xlUp).Row
        .Range("K1").Resize(derlig) = .Range("F1:F" & derlig).Value
        .Range("K1").Resize(derlig).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("K1").Resize(derlig).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        
        derlig = .Range("G" & Rows.Count).End(xlUp).Row
        .Range("M1").Resize(derlig) = .Range("G1:G" & derlig).Value
        .Range("M1").Resize(derlig).RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("M1").Resize(derlig).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    End With
    Application.ScreenUpdating = True
End Sub
0
J'ai un petit problème,à coté des colonnes I,K,M j'ai les colonnes adjacentes J,L,N qui contiennent des formules qui prennent en compte les valeurs des colonnes I,K,M.Il ne faudrait pas supprimer les cellules vides en dessous de la dernière cellule pleine collée dans les colonnes I,K,M.

Je sais j'abuse.

Un grand merci pour ton implication
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
1 juil. 2016 à 19:57
Re,
Comprends pas votre soucis !!!!!!
0
Je vais essayer d'être plus explicite.

à coté des colonnes I,K,M les colonnes adjacentes J,L,N contiennent des formules qui prennent en compte les valeurs des colonnes I,K,M

Formule ci dessous avant collage

=SI(I2>"";RECHERCHEV(I2;'Trier Imprimer'!$B$2:$H$6000;5;FAUX);"")

Formule ci dessous après collage

=SI(#REF!>"";RECHERCHEV(#REF!;'Trier Imprimer'!$B$2:$H$6000;5;FAUX);"")
0
f894009 Messages postés 17205 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 19 octobre 2024 1 709
2 juil. 2016 à 07:36
Bonjour
Ok, je vois, je regarde la chose

À+
0