Modification d'une macro

[niiiiiiiiiico]

Bonjour à tous,

Vous trouverez ci-après une macro (enfin deux) que je souhaiterais modifier (et je remercie SubEndSub au passage !!) :

Option Explicit
'+++++++++++++++++++DEBUT BOUTON 1+++++++++++++++++++++++++++++++
Sub bouton1()
Application.ScreenUpdating = False
BTN1proc1 'suppression
procTri ' tri
Application.ScreenUpdating = True
End Sub
Sub BTN1proc1()
Dim lvm As Long, lf As Long, lh As Long, f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, f4 As Worksheet
Dim VCH As String
'Feuil14 = bdd formations
'Feuil6 = Visite Médicale
'Feuil17 = Formations
'Feuil7 = Habilitations
Set f1 = Feuil14
Set f2 = Feuil6
Set f3 = Feuil17
Set f4 = Feuil7
VCH = Feuil14.[D3]
'Recherche de la valeur en D3 puis effacement
f1.Range("B4:B350").Find([D3], LookAt:=xlWhole).Replace [D3], ""
'Suppression des lignes vides dans la plage B4:B30
f1.Range("B4:B350").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
'Mise de bordures sur cette même plage
f1.Range("B4:B350").Borders.LineStyle = xlContinuous
'Par sécurité, "renommage" de la plage B4:B350 en LNoms
f1.Range("B4:B350").Name = "LNoms"
'Détermination du numéro de ligne dans la bdd formation où a été trouvée
'la valeur saisie en tableau visite médicale, D3
lvm = f2.Range("B12:B" & f2.[B65536].End(xlUp).Row).Find(VCH, LookAt:=xlWhole).Row
'Même chose sur la feuille formations
lf = f3.Range("B26:B" & f3.[B65536].End(xlUp).Row).Find(VCH, LookAt:=xlWhole).Row
lh = f4.Range("B17:B" & f4.[B65536].End(xlUp).Row).Find(VCH, LookAt:=xlWhole).Row
'suppression du contenu des cellules (sans formules) situées sur les lignes
'lvm et lf   (lvm = ligne visite medicale, lf= ligne formation, lh = ligne habilitations)
f2.Range("B" & lvm & ":" & "D" & lvm & ",F" & lvm).ClearContents
f3.Range("B" & lf & ":" & "F" & lf & ",H" & lf & ",J" & lf & ",L" & lf & ",N" & lf & ",P" & lf & ":R" & lf).ClearContents
f4.Range("B" & lh & ":C" & lh & ",E" & lh & ":G" & lh & ",I" & lh & ",K" & lh).ClearContents
'Effacement de la cellule D3 de la feuille 1
Feuil14.[D3] = Null
End Sub
'+++++++++++++++++++FIN BOUTON 1++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'
'+++++++++++++++++++DEBUT BOUTON 2++++++++++++++++++++++++++++++++
Sub bouton2()
Application.ScreenUpdating = False
BTN2proc1
procTri
Application.ScreenUpdating = True
End Sub
Sub BTN2proc1()
Dim vf1 As Long, vf2 As Long, vf3 As Long, vf4 As Long, Noms As Range
Dim c As Range
vf1 = Feuil14.[B65536].End(xlUp)(2).Row
vf2 = Feuil6.[B65536].End(xlUp)(2).Row
vf3 = Feuil17.[B65536].End(xlUp)(2).Row
vf4 = Feuil7.[B65536].End(xlUp)(2).Row
Set Noms = Feuil14.Range("D17:D" & [D65536].End(xlUp).Row)
If Application.WorksheetFunction.CountA(Noms) > 0 Then
Noms.Copy Cells(vf1, "B")
End If
For Each c In [LNoms]
c.Offset(, -1) = Left(c, 1) & Right(c, 1)
Next
Range("A4:B350").Sort Cells(4, 1), xlAscending
Range("A4:A" & [A65536].End(xlUp).Row).ClearContents
Noms.Copy Feuil6.Cells(vf2, "B")
Noms.Copy Feuil17.Cells(vf3, "B")
Noms.Copy Feuil7.Cells(vf4, "B")
Noms.ClearContents
End Sub
'+++++++++++++++++++FIN BOUTON 2++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'
'+++++++++++++++++PROCEDURE DE TRI++++++++++++++++++++++++++++++++
Sub procTri() ' tri des différents tableaux
Dim TriCell2 As Range, TriCell3 As Range, TriCell4 As Range
Dim c As Range
'Feuille 2
Set TriCell2 = Feuil6.Range("B12:B" & Feuil6.[B65536].End(xlUp).Row)
For Each c In TriCell2
c.Offset(, -1) = Left(c, 1) & Right(c, 1)
Next
TriCell2.Offset(, -1).Resize(, 7).Sort Key1:=Feuil6.Range("A6"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
TriCell2.Offset(, -1).ClearContents
'Feuille 3
Set TriCell3 = Feuil17.Range("B26:B" & Feuil17.[B65536].End(xlUp).Row)
For Each c In TriCell3
c.Offset(, -1) = Left(c, 1) & Right(c, 1)
Next
TriCell3.Offset(, -1).Resize(, 18).Sort Key1:=Feuil17.Range("A8"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
TriCell3.Offset(, -1).ClearContents
'Feuille 4
Set TriCell4 = Feuil7.Range("B17:B" & Feuil7.[B65536].End(xlUp).Row)
For Each c In TriCell4
c.Offset(, -1) = Left(c, 1) & Right(c, 1)
Next
TriCell4.Offset(, -1).Resize(, 18).Sort Key1:=Feuil7.Range("A8"), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
TriCell4.Offset(, -1).ClearContents
End Sub

Voici les modifications que je souhaiterais faire :

• Mes 4 feuilles seront protégées, donc j'aimerais qu'elles se déprotègent puis se reprotègent une fois le tri des tableaux effectué.
  
• Lors de l'ajout du nom en D17: Dxxxx, s'il n'y a aucun nom, il ajoute la ligne de titre en D16 et je souhaiterais que ça ne puisse pas se faire
  
• Lors de l'ajout de nom en D17: Dxxxx, il copie également la mise en forme et je souhaiterais que seul le contenu soit copié

Un grand merci par avance !

 

[niiiiiiiiiico]

Re : Modification d'une macro

Bonjour à tous,

Je retente ma chance !

 

[Paritec]

Re : Modification d'une macro

Bonjour Niiiiiiiiiiico, le forum,
oui tu retentes, c'est bien mais je réponds pour déprotéger et reprotéger
tes feuilles;
feuil2.unprotect déprotége le feuille 2
feuil2.protect protège la feuille 2

ou si tu préfères
sheets("feuil2").unprotect
sheets("feuil2").protect
tu mets le premier au début de ta macro avec la feuille concernée
et juste avant le end sub tafeuillle.protect
bonne journée
Papou

 

[Paritec]

Re : Modification d'une macro

Re bonjour Niiiiiiiiiiiiiiiiico le forum
alors pour tes explications

• Lors de l'ajout du nom en D17: Dxxxx, s'il n'y a aucun nom, il ajoute la ligne de titre en D16 et je souhaiterais que ça ne puisse pas se faire
  
• Lors de l'ajout de nom en D17: Dxxxx, il copie également la mise en forme et je souhaiterais que seul le contenu soit copié

Je suppose que toi tu sais ce que tu veux c'est bien, mais relis ta demande et réfléchis un peu tu sauras pourquoi tu n'as pas eu de réponse.
Sur ce forum si tu n'obtiens pas de réponse c'est que tu n'as pas bien posé la question moi je ne comprend pas ce que tu veux et en plus tu donnes pas un petit fichier exemple !!!! D17 : Dxxxxx 's'il y a un nom? on le devine comment? il sert a quoi ? bon bref moi je sais pas faire avec ton énoncé
a+
papou

 

[niiiiiiiiiico]

Re : Modification d'une macro

Bonjour Niiiiiiiiiiico, le forum,
oui tu retentes, c'est bien mais je réponds pour déprotéger et reprotéger
tes feuilles;
feuil2.unprotect déprotége le feuille 2
feuil2.protect protège la feuille 2

ou si tu préfères
sheets("feuil2").unprotect
sheets("feuil2").protect
tu mets le premier au début de ta macro avec la feuille concernée
et juste avant le end sub tafeuillle.protect
bonne journée
Papou

Bonjour Paritec et merci pour ta réponse !!

Pour ton message d'après, ça manque effectivement de clareté. En PJ un fichier avec la base de données à renseigner de D17 à Dxxx (étant limité par la taille du fichier, je ne peux pas mettre mes autres feuilles). Lorsqu'on clique sur ajouter nom, ça l'ajoute dans la première cellule de disponible à partir de B15

Mais si je n'ai rien mis dans ma colonne D17, ça copie le rectangle 3. Je souhaiterais donc que la copie ne puisse pas démarrer avant D17 et je souhaiterais que seul le contenu de la cellule soit copiée (si la police est bleue par ex, je ne veut pas que le format soit copié).

Merci !