XL 2019 Feuille active

farid · 26 Mai 2022

Bonjour,
actuellement j'ai ces deux macros qui fonctionnent très bien , Cependant est ce possible que ces deux macros puissent être actives sur la feuille active et non sur la ou les feuilles écrient sur la ligne de commande de la macro :

la première :

Private Sub CommandButton53_Click()
Worksheets("Feuille_modèle").Columns("19").Replace _
What:="", Replacement:="Contrat", _
SearchOrder:=xlByColumns, MatchCase:=True
End Sub

la deuxième :

Sub copier_cell2()

Dim ws As Worksheet
Application.DisplayAlerts = False
'On vient ensuite boucler sur chaque feuille du classeur voulu
For Each ws In ThisWorkbook.Worksheets

With ws
If .CodeName <> "Feuil1" And .CodeName <> "Feuil2" And .CodeName <> "Feuil3" And .CodeName <> "Feuil4" And .CodeName <> "Feuil9" Then
'Pour ensuite transférer la valeur de la cellule A2 vers la cellule E2 de chaque feuille
ws.Range("W3").FormulaArray = "=IFERROR(Lecteur(R3C2)&"":\Méthode\Devis prestataire\""&INDEX(PARAM!R2C2:R12C2,MATCH(R3C2,PARAM!R2C2:R12C2,0)),"""")"
End If
End With

'On passe à la feuille suivante
Next ws

'**********ATTENTION OBLIGATOIRE*******
Application.DisplayAlerts = True '<== ATTENTION OBLIGATOIRE
'**************************************

End Sub

Par avance , merci
bonne journée

soan · 26 Mai 2022

Re,

pour la 2ème sub, essaye :

VB:

Sub copier_cell2()

  Dim ws As Worksheet
  Application.DisplayAlerts = False
  'On vient ensuite boucler sur chaque feuille du classeur voulu
  For Each ws In ThisWorkbook.Worksheets

    With ws
      If .CodeName <> "Feuil1" And .CodeName <> "Feuil2" And .CodeName <> "Feuil3" And .CodeName <> "Feuil4" And .CodeName <> "Feuil9" Then
        'Pour ensuite transférer la valeur de la cellule A2 vers la cellule E2 de chaque feuille
        Range("W3").FormulaArray = "=IFERROR(Lecteur(R3C2)&"":\Méthode\Devis prestataire\""&INDEX(PARAM!R2C2:R12C2,MATCH(R3C2,PARAM!R2C2:R12C2,0)),"""")"
      End If
    End With

    'On passe à la feuille suivante
  Next ws

  '**********ATTENTION OBLIGATOIRE*******...

soan · 26 Mai 2022

Bonjour farid,

pour la 1ère macro, essaye :

VB:

Private Sub CommandButton53_Click()
  ActiveSheet.Columns(19).Replace _
  What:="", Replacement:="Contrat", _
  SearchOrder:=xlByColumns, MatchCase:=True
End Sub

tu peux essayer aussi :

VB:

Private Sub CommandButton53_Click()
  ActiveSheet.Columns("S").Replace _
  What:="", Replacement:="Contrat", _
  SearchOrder:=xlByColumns, MatchCase:=True
End Sub

soan

Eric C · 26 Mai 2022

Bonjour le forum
Bonjour farid...... Oupssssss.... Bonjour soan (javo pô rafraîchi)

A essayer :

Code:

ActiveSheet ou ActiveSheet.Name

Bonne journée à toutes & à tous
@+ Eric c

soan · 26 Mai 2022

Re,

pour la 2ème sub, essaye :

VB:

Sub copier_cell2()

  Dim ws As Worksheet
  Application.DisplayAlerts = False
  'On vient ensuite boucler sur chaque feuille du classeur voulu
  For Each ws In ThisWorkbook.Worksheets

    With ws
      If .CodeName <> "Feuil1" And .CodeName <> "Feuil2" And .CodeName <> "Feuil3" And .CodeName <> "Feuil4" And .CodeName <> "Feuil9" Then
        'Pour ensuite transférer la valeur de la cellule A2 vers la cellule E2 de chaque feuille
        Range("W3").FormulaArray = "=IFERROR(Lecteur(R3C2)&"":\Méthode\Devis prestataire\""&INDEX(PARAM!R2C2:R12C2,MATCH(R3C2,PARAM!R2C2:R12C2,0)),"""")"
      End If
    End With

    'On passe à la feuille suivante
  Next ws

  '**********ATTENTION OBLIGATOIRE*******
  Application.DisplayAlerts = True '<== ATTENTION OBLIGATOIRE
  '**************************************

End Sub

j'ai seulement mis une indentation, et enlevé le ws. qui était devant Range("W3)

soan

farid · 26 Mai 2022

soan à dit:

Bonjour farid,

pour la 1ère macro, essaye :

VB:

Private Sub CommandButton53_Click()
  ActiveSheet.Columns(19).Replace _
  What:="", Replacement:="Contrat", _
  SearchOrder:=xlByColumns, MatchCase:=True
End Sub

tu peux essayer aussi :

VB:

Private Sub CommandButton53_Click()
  ActiveSheet.Columns("S").Replace _
  What:="", Replacement:="Contrat", _
  SearchOrder:=xlByColumns, MatchCase:=True
End Sub

soan

Bonsoir Soan ,Eric C
merci pour ce retour rapide et efficace.
Bien cordialement

XL 2019 Feuille active

farid

XLDnaute Occasionnel

soan

soan

XLDnaute Barbatruc

Eric C

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

farid

XLDnaute Occasionnel

Discussions similaires