Sujet Précédent Sujet Suivant

Macro Triage de plusieurs colonnes

Résolu/Fermé
Lorenzo - 1 mai 2013 à 14:03
 Lorenzo - 1 mai 2013 à 15:27
Bonjour,
J'espère qu'une âme charitable pourra m'aider dans ma quête.
J'ai un tableau de 3x2 colonnes sur 18 lignes dont les cellules comprennent des heures (format 0:00), représentant des plages horaires pour travailleurs (2 colonnes = 1 plage)
Mon but est d'obtenir un deuxième tableau de deux colonnes en dessous du tableau initial reprenant les différentes plages horaires classées chronologiquement; les doublons éventuels étant éliminés.
Il est très probable que certaines cellules du tableau initial soient vides.
Cette macro sera utilisée sur un bouton.
Merci d'avance pour vos lumières
Laurent



1 réponse

Réponse 1 / 1
Lorenzo
1 mai 2013 à 15:27
Résolu!! comme un grand tout seul...
J'ai enregistré une macro et nettoyé les lignes de codes inutiles.
C'est peut-être pas parfait au niveau du code mais cela fonctionne.

Voici la macro pas très esthétique : 
Sub Macro4()
    Range("I2:J18").Select
    Selection.Copy
    Range("A25").Select
    ActiveSheet.Paste
    Range("K2:L18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A42").Select
    ActiveSheet.Paste
    Range("M2:N18").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A58").Select
    ActiveSheet.Paste
    Range("A25:B100").Select
    Application.CutCopyMode = False
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A25:A100") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B25:B100") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A25:B100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A25:B100").Select
    ActiveSheet.Range("$A$25:$B$100").RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlNo
    Range("C25").Select
End Sub
0