Code imcomplet

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

4 réponses

  1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
  2. 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
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      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
  3. 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
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Re,
      Comprends pas votre soucis !!!!!!
      0
  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);"")
    0
    1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
       
      Bonjour
      Ok, je vois, je regarde la chose

      À+
      0