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