Transfert de données et traitement à la réception.

domlou

XLDnaute Nouveau
1. Bonsoir,


Après une compilation des échanges du Forum, je suis parvenu à élaborer l'application que je recherchais, mais j'arrive à la phase finale, et là, je patine...
La PJ n'est qu'une extraction mais je pense assez explicite.

Au final , je recherche pour l'onglet "Fichier(2) ":
- que les enregistrements soient triés suivant les colonnes A , D et E
- que les lignes pour lesquels il n'existe pas de données dans ces colonnes soient supprimées
- que la prochaine extraction du "Fichier" débute à la première ligne vide du "Fichier(2)".


Dans le même temps, pour l'onglet "Fichier":
- que les lignes pour lesquels il existe des données dans ces colonnes soient supprimées.

Merci pour votre aide

Cordialement

DOMLOU
 

Pièces jointes

  • Problème.zip
    103.1 KB · Affichages: 29
  • Problème.zip
    103.1 KB · Affichages: 29
  • Problème.zip
    103.1 KB · Affichages: 29

Fred0o

XLDnaute Barbatruc
Re : Transfert de données et traitement à la réception.

Bonsoir domlou,

Tu peux essayer avec ce code :
VB:
Sub Extrait()
    Dim i
    ActiveWorkbook.Worksheets("Fichier (2)").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Fichier (2)").Sort.SortFields.Add Key:=Range( _
        "A3:A1500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Fichier (2)").Sort.SortFields.Add Key:=Range( _
        "D3:D1500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Fichier (2)").Sort.SortFields.Add Key:=Range( _
        "E3:E1500"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Fichier (2)").Sort
        .SetRange Range("A3:H1500")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For i = [B65536].End(xlUp).Row To 3 Step -1
        If Cells(i, 2) = "" Then Cells(i, 2).EntireRow.Delete shift:=xlUp
    Next
    Cells([A65536].End(xlUp).Row + 1, 1).Select
End Sub

La dernière ligne :
VB:
Cells([A65536].End(xlUp).Row + 1, 1).Select
te positionne en colonne A sur la première ligne vide.

A+
 

Discussions similaires

Réponses
7
Affichages
410

Statistiques des forums

Discussions
312 505
Messages
2 089 070
Membres
104 020
dernier inscrit
Mzghal