Boucle sur le nom des onglets

Fermé
Nonnoo Messages postés 25 Date d'inscription lundi 14 mars 2016 Statut Membre Dernière intervention 9 juin 2016 - 30 mai 2016 à 16:41
Bonjour,

Je souhaite avoir une boucle qui me réalise cette action :
- si le nom du fichier A apparaît dans un de mes onglets de mon fichier B alors "Code..."
si non (càd si un fichier nommé AA existe mais n'existe pas en tant qu'onglet dans mon fichier B ) alors ouvrir le fichier AA et copier l'onglet, créer un onglet à la fin dans le fichier B et coller les éléments. Copier/Coller également le nom de l'onglet.

J'ai déjà un début de code mais ca ne marche pas bien .... Voici mon code :
Bouton1_Cliquer()
Dim FichierMacro As String
Dim Chemin As String
Dim DossierDB As String
Dim FichierDB As String

FichierMacro = ActiveWorkbook.Name
Chemin = ActiveWorkbook.Path

Application.ScreenUpdating = False
Application.DisplayAlerts = False

DossierDB = Sheets("Macro").Range("A2")
If DossierDB <> "" Then
FichierDB = Dir(Chemin & "\" & DossierDB & "\SX*.xls")

Do Until FichierDB = ""
Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False

If FichierDB = UCase(ActiveSheet.Name) Like "*SX*" Then

Windows(FichierMacro).Activate
Sheets(Left(FichierDB, Len(FichierDB) - 4)).Select
Rows("7:7").Select
Range(Selection, Selection.End(xlDown)).ClearContents

Workbooks(FichierDB).Activate
Rows("7:1000").Select
Selection.Copy
Windows(FichierMacro).Activate
ActiveSheet.Paste

Workbooks(FichierDB).Activate
ActiveWorkbook.Close True
Application.Wait (Now + TimeValue("00:00:01"))
FichierDB = Dir

Else
Workbooks.Open (Chemin & "\" & DossierDB & "\" & FichierDB), UpdateLinks:=False
Workbooks(FichierDB).Activate
Cells.Select
Selection.Copy
Windows(FichierMacro).Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveWindow.DisplayGridlines = False
ActiveWindow.Zoom = 85
Application.CutCopyMode = False
Workbooks(FichierDB).Activate
ActiveSheet.Name.Copy
Windows(FichierMacro).Activate
ActiveSheet.Name.Paste
End If

Loop


End If

Sheets("Macro").Select
ActiveCell.Offset(1, 0).Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox ("La compilation est terminée")

End Sub


Merci d'avance pour votre aide,

Nono