XL 2019 Ajout de condition dans une VBA

  • Initiateur de la discussion Initiateur de la discussion farid
  • Date de début Date de début

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 !

farid

XLDnaute Occasionnel
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
 
- 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

  • Question Question
Microsoft 365 Excel VBA
Réponses
5
Affichages
339
Réponses
4
Affichages
332
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
45
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
213
Retour