Option Explicit
Sub enregistrer()
Dim nomfeuille1 As String
Dim col1 As String
Dim classeur1 As String
Dim lidep1 As Long
Dim chemin As String
Dim sh As Worksheet
Dim classeur2 As String
Dim i As Integer
Dim data1 As String
'**********************************
' récupération des noms
chemin = ThisWorkbook.Path & "\"
classeur1 = ActiveWorkbook.Name
nomfeuille1 = ActiveSheet.Name '
With Workbooks(classeur1).Sheets(nomfeuille1)
' recherche du nom du classeur et ouverture
classeur2 = .Range("a1").Value & ".xls" ' par exemple"Facture.xls"
Workbooks.Open Filename:=chemin & classeur2
' on vérifie si la feuille n'est pas existante
For Each sh In Sheets()
If sh.Name = nomfeuille1 Then
Call MsgBox("La feuille est déjà enregistrée", vbInformation, Application.Name)
Application.ScreenUpdating = False 'gele l'ecran
Application.DisplayAlerts = False 'interdit les messages d'avertissements
ActiveWorkbook.Close
Exit Sub
End If
Next sh
' copie de la feuille
.Copy After:=Workbooks(classeur2).Sheets(Workbooks(classeur2).Worksheets.Count)
ActiveSheet.Name = nomfeuille1
ActiveWorkbook.Save
ActiveWorkbook.Close
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub