XL 2019 Ajout de condition dans une VBA

farid

XLDnaute Occasionnel
Supporter XLD
Bonjour a vous toutes et tous,
ci dessous, un macro qui fonctionne très bien.
Cependant je souhaiterais mettre une condition a savoir que cette MACRO fonctionne si la feuille "TABLEAU-OT-2021.xlsm" est bien activité sinon si pas activé je Call sur une macro.
Par avance, merci
Farid

Sub enregistrementseul()

0 Application.ScreenUpdating = False
Application.DisplayAlerts = False

Nm = ActiveWorkbook.Name
If Left(Nm, 2) = "21" Then rep1 = ActiveWorkbook.Path Else rep1 = ActiveWorkbook.Path & "\SAUVEGARDE-OT-2021"

'Stop
nom = Range("A5").Value & ".xlsm"
rep1 = rep1 & "\" & nom
a = Left(nom, 2): ActiveWorkbook.SaveAs rep1
Range("A5:S5").Copy

Workbooks("TABLEAU-OT-2021.xlsm").Activate
rep2 = Workbooks("TABLEAU-OT-2021.xlsm").Path & "\"
Workbooks.Open rep2 & "LOG.xlsm"

Windows("LOG.xlsm").Activate
Set celluletrouvee = Workbooks("LOG.xlsm").Sheets("Feuil1").Range("A1:A5000").Find(Left(nom, 5), lookat:=xlWhole)

If celluletrouvee Is Nothing Then
derligne = Workbooks("TABLEAU-OT-2021.xlsm").Sheets("Synthèse").Range("A65536").End(xlUp).Row + 1
Else

derligne = celluletrouvee.Offset(0, 1)
End If
Workbooks("TABLEAU-OT-2021.xlsm").Activate
'derligne = Sheets("Feuil1")
'If Left(Nm, 2) = "19" Then derligne = Range("AA1").Value Else derligne = Sheets("Synthèse").Range("A65536").End(xlUp).Row + 1
Range("A" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks(nom).Activate
Range("wa8:wa33").Select
Selection.Copy
Workbooks("TABLEAU-OT-2021.xlsm").Activate
rep2 = ActiveWorkbook.Path & "\"
Range("xx" & derligne).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True


Application.DisplayAlerts = False
'Stop
Workbooks.Open rep2 & "LOG.xlsm"
Windows("LOG.xlsm").Activate
Set celluletrouvee = Sheets("Feuil1").Range("A1:A500").Find(Left(nom, 5), lookat:=xlWhole)

If celluletrouvee Is Nothing Then GoTo suite

derligne = celluletrouvee.Row 'Sheets("Feuil1").Range("A65536").End(xlUp).Row
Sheets("Feuil1").Range("A" & derligne & ":B" & derligne).Delete
ActiveWorkbook.Save

'End If
suite:

ActiveWorkbook.Close

Workbooks(nom).Close

End Sub
 

CHALET53

XLDnaute Barbatruc
Bonjour,
ça me rappelle quelque chose....
Peut-être
Mettre en début de programme une instruction du type :
Nfeuille=ActiveSheet.Name
if Nfeuille<> "TABLEAU-OT-2021.xlsm" then call (ta macro)

Il est bizarre le nom de ta feuille (TABLEAU-OT-2021.xlsm)
 

Discussions similaires

Réponses
77
Affichages
1 K
Réponses
2
Affichages
191

Membres actuellement en ligne

Statistiques des forums

Discussions
293 047
Messages
1 928 124
Membres
183 853
dernier inscrit
ali1987