Simplification d'une macro

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
L

liquoreux

XLDnaute Junior
Bonjour,

J'ai une macro qui marche bien mais que je souhaiterais simplifier :

En effet, la première série transforme en majuscule chaque Nom dans plusieurs colonnes réparties à plusieurs endroits. Je souhaiterais que cette transformation soit liée au nom des colonnes et non à leur emplacement dans le tableau :

'Transforme en majuscule chaque Nom dans la colonne NOM'
Range("B1", Range("B1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne BUREAU DISTRIBUTEUR'
Range("K1", Range("K1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne CANDIDATURE SPONTANNEE'
Range("L1", Range("L1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne REPONSE A ANNONCE'
Range("Q1", Range("Q1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne SERVICE'
Range("X1", Range("X1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne REPONSE A CANDIDATURE'
Range("G1", Range("G1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne REPONSE DU SERVICE'
Range("AA1", Range("AA1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell
Cliquez pour agrandir...


Idem pour les lignes qui transforment en majuscules la première lettre du mot :


'Transforme en majuscule la première lettre de chaque Prénom dans la colonne PRENOM'
Range("C1", Range("C1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell

'Transforme en majuscule la première lettre de chaque Mot dans les colonnes ADRESSES N°1 et N°2'
Range("H1:I1", Range("H1:I1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell

'Transforme en majuscule la première lettre de chaque Mot dans les colonnes POSTE DEMANDE N°1 à TOUT POSTE'
Range("M1😛1", Range("M1😛1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell

'Transforme en majuscule la première lettre de chaque Mot dans les colonnes POSTE DEMANDE N°1 à TOUT POSTE'
Range("S1:T1", Range("S1:T1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell
Cliquez pour agrandir...


Idem pour les lignes qui vérifient que les valeurs rentrées sont bien des dates et qui indiquent les erreurs en rouge avec un message d'alerte. Stoppent la procédure s'il y a des erreurs :

Colonnes :
D : Date lettre candidat
E : Date lettre attente
F : Date reponse
R : Date annonce
U : Date entretien n°1
V : Date entretien n°2
W : Date entretien n°3
Y : Date denvoi
Z : Date de retour

'vérifie que les valeurs rentrées sont bien des dates et indique les erreurs en rouge avec un message d'alerte. Stoppe la procédure s'il y a des erreurs

Range("D2:F2", Range("D2:F2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next

Range("R2:R2", Range("R2:R2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next

Range("U2:W2", Range("U2:W2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next

Range("Y2:Z2", Range("Y2:Z2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next
Cliquez pour agrandir...

Merci pour votre aide
 

Pièces jointes

Trier par date Trier par votes
Re : Simplification d'une macro

bonjour liquoreux

Ta macro simplifiée en Module2 sous le nom de Transfert1
De plus elle te permet de mettre tes colonnes ou tu le souhaites
Seule contrainte: Conserver les titres en ligne 1 et ne pas les modifier (si modification intervenir dans la macro)

NB:Je n'ais pas tout testé , si pb ne pas hesiter à revenir
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Simplification d'une macro

J'ai essayé mais le contrôle des dates balaye aussi les titres, qui ne sont pas des dates, et cela pose un problème.
C'est la raison pour laquelle la macro initiale commence sur la 2ème ligne de chaque colonne concernée.
 
Vote positif 0 Vote négatif
Re : Simplification d'une macro

Re

OK

Remplacer

Code: 
.....
Set c = Sheets("SAISIE").Rows(1).Find([COLOR=red]Liste3[/COLOR](n), LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
       Range(c,c.EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
       For Each cell In Selection
.....

par

Code: 
....
Set c = Sheets("SAISIE").Rows(1).Find([COLOR=red]Liste3[/COLOR](n), LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
       Range(c[COLOR=blue].Offset(1, 0[/COLOR][COLOR=blue])[/COLOR], c.[COLOR=blue]Offset(1, 0[/COLOR][COLOR=blue])[/COLOR].EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
       For Each cell In Selection
......
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

T
  • Résolu(e)
Microsoft 365 Insérer une image DANS une cellule
Réponses
12
Affichages
844
Thomi
T
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
233
telemarrk
T
M
  • Question Question
XL 2010 VBA
Réponses
6
Affichages
522
Hasco
Hasco
S
  • Question Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
386
souhaib ad
S
V
  • Résolu(e)
XL 2021 Complétion d'un tableau automatisée
Réponses
9
Affichages
948
VincentH.DR
V
N
  • Question Question
XL 2021 BESOIN D'aide macro
Réponses
7
Affichages
810
Gégé-45550
Gégé-45550
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
145
JJ69
J
J
  • Question Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
3 K
jui42
J
PHV.FSM
  • Question Question
XL 2016 Calculer la position sur l'écran d'une position sur la grille (XL 2003)
2
Réponses
27
Affichages
3 K
Nicolas JACQUIN
Nicolas JACQUIN
J
  • Question Question
XL 2019 Sélection d'une plage de données via .Address
Réponses
2
Affichages
655
jui42
J
Usine à gaz
  • Résolu(e)
Microsoft 365 Calendrier : Modifier Target > change R
Réponses
10
Affichages
2 K
Usine à gaz
Usine à gaz
A
  • Résolu(e)
XL 2019 Inversion date avec macro import
Réponses
14
Affichages
1 K
Arnaud59000
A
V
  • Question Question
XL 2016 [RESOLU] Traduction code VBA (code trouvé sur internet je ne comprend rien)
2
Réponses
17
Affichages
3 K
VBgalère
V
T
  • Question Question
XL 2016 Problème de conditions
Réponses
1
Affichages
1 K
nat54
nat54
L
  • Question Question
XL 2010 macro qui bug qui feuille protégée
Réponses
6
Affichages
942
LAPIN-53
L
A
  • Question Question
XL 2016 VBA - Optimisation d'exécution d'une ligne de code [For Each Cell In Selection > IF... > Next]
Réponses
5
Affichages
1 K
zebanx
zebanx
O
  • Question Question
XL 2010 Envoi de mail en VBA avec liens hypertextes [RESOLU]
Réponses
12
Affichages
6 K
olivier974s
O
Bernard_XLD
  • Suggestion Suggestion
Date et heure Jours fériés automatiques
Réponses
10
Affichages
10 K
baptistou
B
F
  • Résolu(e)
XL 2016 accélerer une macro en utilisant un tableau à une dimension
Réponses
3
Affichages
2 K
FRANCOIS GROSJEAN
F
bellenm
  • Question Question
Gmail via CDO, attacher un fichier PDF, des adresses, un objet et un corps bien définit, code de Roland_M.
2 3
Réponses
43
Affichages
6 K
Roland_M
Roland_M
Retour