Modification macro ouverture et fermeture

[smeto]

Bonjour à tous,
je chercher à modifier le code ci-dessous pour pouvoir ouvrir et fermer le fichier Arbo automatiquement pendant l'exécution du code,
parce que dans le cas actuel je suis obligé de garder le fichier Arbo ouvert pour exécuter le code que j'ai sur EOTP, si non le code affiche erreur

Merci d'avance

Sub test()

Dim dl1 As Integer, dl2 As Integer, i As Integer

 Set arbo = Workbooks("Arbo.xlsx").Sheets("Sheet1")
 Set eotp = ThisWorkbook.Sheets("EOTP")

 dl1 = arbo.Range("A" & Rows.Count).End(xlUp).Row


  arbo.Range("B2:C" & dl1).Copy eotp.Range("A8")
  With eotp
    dl2 = eotp.Range("A" & Rows.Count).End(xlUp).Row
       .Range("A8:B8").Interior.ColorIndex = 4          'RGB(0, 255, 0)
  For i = 8 To dl2
    If .Range("B" & i) = "COMPTES TRANSITOIRES" Or .Range("B" & i) = "INTRA" Or .Range("B" & i) = "EXTRA" Then
       .Range("A" & i & ":B" & i).Interior.ColorIndex = 3      'RGB(0, 176, 240)
    End If
   
    If .Range("B" & i) = "COMPTE PROVISOIRE" Or .Range("B" & i) = "PRODUCTION" Or .Range("B" & i) = "AUTRES MATERIAUX" Or .Range("B" & i) = "MATOS" Or .Range("B" & i) = "ACHATS" Then
       .Range("A" & i & ":B" & i).Interior.ColorIndex = 8       'RGB(255, 51, 0)
    End If
  Next i
 End With

End Sub

 

[ChTi160]

Bonjour smeto
Bonjour le Fil ,le Forum
une approche
les deux fichiers sont dans le même Dossier.

Sub Test()
Dim WkB_Cible As Workbook
Dim Chemin As String
Dim dl1 As Integer, dl2 As Integer, i As Integer
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & "/Arbo.xlsx"
Set WkB_Cible = Workbooks.Open(Chemin)
 Set Ws_Arbo = WkB_Cible.Sheets("Sheet1")
 Set eotp = ThisWorkbook.Sheets("EOTP")
 With WkB_Cible
  With Ws_Arbo
 dl1 = .Range("A" & Rows.Count).End(xlUp).Row
   With .Range("B2:C" & dl1)
       .Copy eotp.Range("A8")
   End With
  End With
   .Close True
 End With
  With eotp
    dl2 = eotp.Range("A" & Rows.Count).End(xlUp).Row
       .Range("A8:B8").Interior.ColorIndex = 4          'RGB(0, 255, 0)
  For i = 9 To dl2
              StrColor = xlNone
    If .Range("B" & i) = "COMPTES TRANSITOIRES" Or .Range("B" & i) = "INTRA" Or .Range("B" & i) = "EXTRA" Then
              StrColor = 3      'RGB(0, 176, 240)
    ElseIf .Range("B" & i) = "COMPTE PROVISOIRE" Or .Range("B" & i) = "PRODUCTION" Or .Range("B" & i) = "AUTRES MATERIAUX" Or .Range("B" & i) = "MATOS" Or .Range("B" & i) = "ACHATS" Then
              StrColor = 8       'RGB(255, 51, 0)
    End If
           .Range("A" & i & ":B" & i).Interior.ColorIndex = StrColor
  Next i
 End With
              StrColor = xlNone
  Application.ScreenUpdating = True
End Sub

Sub efface()
Dim dl2 As Integer
 With Sheets("EOTP")
   dl2 = .Range("A" & .Rows.Count).End(xlUp).Row
    With .Range("A8:B" & dl2)
         .Interior.ColorIndex = xlNone
         .ClearContents
    End With
 End With
End Sub

jean marie

 

[ChTi160]

Re
Question la Ligne 8 doit elle toujours être en Vert ?
le code ci dessus a été modifié.
jean marie

 

[smeto]

Bonjour CHTI160,
merci pour la modification,
pour répondre à votre question je dirais oui la ligne 8 doit être toujours en vert

 

[smeto]

Re CHTI160,
est ce que c'est possible de modifier dans le code une ligne pour cadrer le tableau comme je l'ai fait manuellement
et de colorer en Jaune toutes les cellules de la colonne B qui commence avec COMMERCE

 

[ChTi160]

Re
Ton fichier modifié.
jean marie

 

[smeto]

Re CHTI160,
pour le mot commerce le code ne colore en jaune que les cellules qui contiennent exactement le mot commerce, alors qu'il doit colorer toutes les cellules qui commencent avec Commerce,
exemple Commerce international, commerce Interne...Ect

 

[smeto]

Bonjour,
je pense que ce n'est pas possible la dernière modif

 

[ChTi160]

Bonjour smeto
Bonjour le Fil ,le Forum
Si c est possible!
Je vois ca desque je peux
Jean marie

 

[ChTi160]

Re
le fichier modifié
jean marie

 

[smeto]

Bonjour Jean marie,
merci beaucoup, la nouvelle version marche très bien sauf que cette fois le code supprime les titres de la ligne 7, chose qui n'existait pas dans les autres versions

 

[ChTi160]

Re
Tu remplaces la macro "efface"
par celle ci.

Sub efface()
Dim dl2 As Integer
 With Sheets("EOTP")
   dl2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1 'ici j'ai modifié "Plus 1"
    With .Range("A8:B" & dl2)
         .Interior.ColorIndex = xlNone
         .Borders.LineStyle = xlNone
         .ClearContents
    End With
 End With
End Sub

jean marie

 

[smeto]

Re,
cette fois ça fonctionné, entre autre fallait pas annuler cette partie du code ?? (parce que ça évite aussi le même problème)

'****************
efface
'****************

Merci beaucoup