Code imcomplet

VDB.57 -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention - 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

Afficher la suite

A voir également:

Code imcomplet
Code ascii - Guide
Code puk bloqué - Guide
Code activation windows 10 - Guide
Comment déverrouiller un téléphone quand on a oublié le code - Guide
Code blocks - Télécharger - Langages

4 réponses

Réponse 1 / 4

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Réponse 2 / 4

VDB.57

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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

Réponse 3 / 4

VDB.57

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Re,
Comprends pas votre soucis !!!!!!

Réponse 4 / 4

VDB.57

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);"")

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour
Ok, je vois, je regarde la chose

À+

Discussions similaires

sertissage des cables rj45

Votre réponse

Discussions similaires