cherche mac pour copier 1 matricule (j'ai déja testé la fonction IF, trop long)...j'explique
Dans la cellule D16 de la feuille "module" j'ai 1 matricule
je veux que cette matricule soit copiée dans la colonne B des feuilles BD1 BD2 et BD3 à chaque qu'il y a des données dans ces colonnes
Salut jborm, le fil,
Si l'entité venait à être un nombre, la condition ESTTEXTE serait fausse, donc on ne peut pas appliquer ça. On peut appliquer si ESTVIDE = Faux en revanche. @anasimo comment ça quand tu ajoutes d'autres données ?
Salut Anasimo tu as qu'à mettre sous forme de tableau. A chaque fois que tu rajoutes une ligne les formules restent.
Upsilon a raison utilise estvide, c'est plus adapté que esttexte.
Salut jborm, le fil,
Si l'entité venait à être un nombre, la condition ESTTEXTE serait fausse, donc on ne peut pas appliquer ça. On peut appliquer si ESTVIDE = Faux en revanche. @anasimo comment ça quand tu ajoutes d'autres données ?
Voila je vais mettre un fichier qui comprend une macro qui marche bien et répond à mes attentes (j'ai récupéré un bout développé par Dranreb) ...et je veux la corriger et l'adapter à mon fichier (supprimer les codes en trop ...) et mettre les noms de feuilles (modules, BD1,2et3) au lieu de Feui1 et Feuil2
le code déja utilisé....je sais qu'il faut le nettoyer car y a des éléments de trop
VB:
Sub générer()
Dim CelADéb As Range, NbLig As Long
Set CelADéb = Feuil2.[A1000000].End(xlUp).Offset(1)
NbLig = Feuil2.[D1000000].End(xlUp).Row + 1 - CelADéb.Row
If NbLig > 0 Then
With CelADéb.Resize(NbLig)
.Formula = "=""" & Feuil1.[D16].Value _
& """&TEXT(ROW()-" & CelADéb.Row - 1 & ","""")"
.Value = .Value: End With
End If
End Sub
Voyez le fichier joint et cette macro dans le code de ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim matricule As Range, w As Worksheet
Set matricule = Sheets("module").[D16] 'cellule à adapter au besoin
If Sh.Name = matricule.Parent.Name Then
If Intersect(Target, matricule) Is Nothing Then Exit Sub
For Each w In Worksheets
Workbook_SheetChange w, w.Cells(1) 'déclenche la macro
Next
ElseIf UCase(Sh.Name) Like "BD#*" Then
Application.EnableEvents = False 'désactive les évènements
With Sh.Cells(1).CurrentRegion
If .Rows.Count > 1 Then .Cells(2, 2).Resize(.Rows.Count - 1) = matricule 'remplissage de la 2ème colonne
End With
Application.EnableEvents = True 'réactive les évènements
End If
End Sub
La macro se déclenche quand on modifie une cellule quelconque dans une des feuilles.
Voyez le fichier joint et cette macro dans le code de ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim matricule As Range, w As Worksheet
Set matricule = Sheets("module").[D16] 'cellule à adapter au besoin
If Sh.Name = matricule.Parent.Name Then
If Intersect(Target, matricule) Is Nothing Then Exit Sub
For Each w In Worksheets
Workbook_SheetChange w, w.Cells(1) 'déclenche la macro
Next
ElseIf UCase(Sh.Name) Like "BD#*" Then
Application.EnableEvents = False 'désactive les évènements
With Sh.Cells(1).CurrentRegion
If .Rows.Count > 1 Then .Cells(2, 2).Resize(.Rows.Count - 1) = matricule 'remplissage de la 2ème colonne
End With
Application.EnableEvents = True 'réactive les évènements
End If
End Sub
La macro se déclenche quand on modifie une cellule quelconque dans une des feuilles.
oui ça marche.....mais 2 soucis
- si on efface les données d'une ligne le code ne s'efface pas.
- Si je change le code il remplace celui déja saisi. (ça posera problème de traçabilité)
Il ne faut pas effacer une ligne mais la supprimer entièrement.
Pour le reste voyez ce fichier (2) et la nouvelle macro :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim matricule As Range, w As Worksheet
Set matricule = Sheets("module").[D16] 'cellule à adapter au besoin
If Sh.Name = matricule.Parent.Name Then
If Intersect(Target, matricule) Is Nothing Then Exit Sub
For Each w In Worksheets
Workbook_SheetChange w, w.Cells(1) 'déclenche la macro
Next
ElseIf UCase(Sh.Name) Like "BD#*" Then
Application.EnableEvents = False 'désactive les évènements
With Sh.Cells(1).CurrentRegion.Columns(2)
If Application.CountBlank(.Cells) Then .SpecialCells(xlCellTypeBlanks) = matricule 'remplit les cellules vides de la 2ème colonne
End With
Application.EnableEvents = True 'réactive les évènements
End If
End Sub
Maintenant si vous préférez utiliser des boutons c'est très simple :
VB:
Sub MAJ()
On Error Resume Next 'si aucune SpecialCell
If UCase(ActiveSheet.Name) Like "BD#*" Then [A1].CurrentRegion.Columns(2).SpecialCells(xlCellTypeBlanks) = Sheets("module").[D16]
End Sub