1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| Sub test()
Dim DerLig As Long, Plage As Range, C As Range, Lig As Long
'on travaille sur la feuille "Stage". Les plages précédées d'un "."
'appartiennent à cette feuille
With Sheets("Stage")
'calcul de la dernière ligne de la colonne A (25 dans le classeur)
DerLig = .Cells(.Rows.Count, 1).End(xlUp).Row
'définition de la plage H:J
Set Plage = .Range("H1" & ":J" & DerLig)
'copie de la plage en A1 de la feuille BIO
Plage.Copy [BIO!A1]
'calcul de la première cellule vide de la colonne A
Lig = [BIO!A65000].End(xlUp).Row + 1
'définition de la plage Q:R de la feuille "Stage"
Set Plage = .Range("Q2" & ":R" & DerLig)
'Copie de cette plage sous la plage de la feuille BIO
Plage.Copy Sheets("BIO").Cells(Lig, 1)
'définition de la plage de la colonne T de la feuille "Stage"
Set Plage = .Range("T2" & ":T" & DerLig)
'copie en colonne C de la feuille BIO
Plage.Copy Sheets("BIO").Cells(Lig, 3)
End With
'on travaille sur la feuille "BIO". Les plages précédées d'un "."
'appartiennent à cette feuille
With Sheets("BIO")
'calcul de la dernière ligne de la colonne A
DerLig = .Cells(.Rows.Count, 1).End(xlUp).Row
'détermination de la plage A:B
Set Plage = .Range("A2" & ":B" & DerLig)
'Boucle sur chaque cellule de cette plage
For Each C In Plage
'Transformation de la cellule en minuscules
C.Value = LCase(C.Value)
'suppression des accents
C.Value = Sans_accents(C)
Next C
'suppression des lignes dont la cellule de la colonne A est vide
'quand on supprime des lignes, il faut commencer par la dernière ligne en remontant
'boucle de la dernière ligne à la ligne 2
For i = DerLig To 2 Step -1
'si la cellule de la colonne A est vide, on supprime la ligne
If .Cells(i, 1).Value = "" Then Rows(i).Delete
Next i
'calcul de la dernière ligne de la colonne A (pour tenir compte des suppressions)
DerLig = .Cells(.Rows.Count, 1).End(xlUp).Row
'définition de la plage C
Set Plage = .Range("C2" & ":C" & DerLig)
'Alignement du texte à gauche (les dates des profs sont centrées)
Plage.HorizontalAlignment = xlLeft
'boucle sur la plage pour suppression des espaces en trop
For Each C In Plage
'si on trouve un espace
If InStr(1, C.Value, " ") > 0 Then
'on applique l'équivalent de SUPPRESPACE
C.Value = Application.Trim(C.Value)
End If
Next C
'Suppression des doublons
.Range("A1:C" & DerLig).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End With
End Sub |
Partager