Export données et colorer certaines lignes

Bonjour tout le monde

sur le classeur EOTP je souhaite avoir un code qui permet d'importer les colonnes B & C (à partir de B2 & C2) du fichier Arbo et les coller dans les colonnes A & B (à partir de A8 & B8) du fichier EOTP avec trois petites conditions :

>> après importation le code doit colorer les cellules A8 et B8 en vert

>> puis le code doit vérifier dans la colonne B de la feuille EOTP s'il trouve les textes suivants (Comptes Transitoires, Intra, Extra) il colore les cellules A & B en rouge (comme j'ai fait manuellement)

>> enfin le code doit vérifier dans la colonne B de la feuille EOTP s'il trouve les textes suivants (Compte provisoire, production, Autres Materiaux, Matos, Achats, ) il colore les cellules A & B en bleu (comme j'ai fait manuellement)

Merci de vous intéresser a mon projet

Cordialement

SMETO

Bonjour,

une proposition.

Sub test()
Set arbo = Workbooks("Arbo.xlsx").Sheets(1)
Set tp = Workbooks("Eotp.xlsm").Sheets(1)

last_row = arbo.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To last_row
    tp.Range("A8:B8").Interior.Color = RGB(0, 255, 0)
    tp.Cells(i + 6, "A") = arbo.Cells(i, "b")
    tp.Cells(i + 6, "B") = arbo.Cells(i, "C")
    b = tp.Cells(i, "b")
    If b = "Compte provisoire" Or b = "production" Or b = "Autres Materiaux" Or b = "Matos" Or b = "Achats" Then
        Range("A" & i, "B" & i) = Interior.Color = RGB(0, 176, 240)
    Else
        If b = "Comptes Transitoires" Or b = "Intra" Or b = "Extra" Then
            Range("A" & i, "B" & i) = Interior.Color = RGB(255, 51, 0)
        End If
    End If

Next i
End Sub

Bonjour Mus54

merci pour votre assistance

le code beug sur cette ligne Set arbo = Workbooks("Arbo.xlsx").Sheets(1)

Bonsoir,

Set tp = Workbooks("Eotp.xlsm").Sheets(1)

EOTP.xlsm ?

Bonne soirée,

Bonsoir xorsankukai

ça ne fonctionne toujours pas

Re,

Sur mon pc, aucun beug....

Cordialement,

Bonsoir xorsankukai,

ça ne fonctionne pas du tout chez moi

Re-Bonsoir,

Est-ce la macro qui ne fonctionne pas où as-tu encore le bug ?

Bonsoir,

Salut xorsankukai )

Tu devrais surement avoir un mauvais nommage. Vérifie le nom de chaque classeur, les extensions et assure toi que les informations se trouvent bien sur les feuilles 1 de chaque feuille. Autrement tu modifie cela :

Set arbo = Workbooks("Arbo.xlsx").Sheets(1)
Set tp = Workbooks("Eotp.xlsm").Sheets(1)

par cela :

Set arbo = Workbooks("Arbo.xlsx").Sheets("NOM DE MA FEUILLE ICI")
Set tp = Workbooks("Eotp.xlsm").Sheets("NOM DE MA FEUILLE ICI")

Re,

Salut Mus54,

Je partage ton avis, surement un problème de nom.....de même pour les conditions, elles sont toutes en majuscules contrairement à l'énoncé,

Une autre proposition, le code diffère légèrement du tien...

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
[attachment=0]EOTP.xlsm[/attachment]

End Sub

Bonne soirée ,

Bonsoir tout le monde,

le code beug toujours même si j'ai vérifié tout, les noms sont les mêmes c'est bizarre

Re,

Tu ouvres bien les 2 classeurs avant d'éxécuter la macro ?.

Sur mon pc, cette erreur se produit si le classeur Arbo est fermé.

Bonjour xorsankukai,

vous avez bien dit, moi aussi je laisse le fichier Arbo fermé, parce que tout les solutions concernant l'importation que je trouve sur le net, les développeur ajoute dans le code une instruction qui permet d'ouvrir et fermer le fichier automatiquement.

peut-on rajouter cette option sur votre dernier code. ce serait impeccable comme solution

Merci de votre assistance

Bonjour smeto, le forum,

une instruction qui permet d'ouvrir et fermer le fichier automatiquement.

A tester.....attention, il te faut modifier le chemin d'accès...

Workbooks.Open Filename:= _
        "C:\Users\maison\Desktop\Smeto\Arbo.xlsx"

Sub test()

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

Workbooks.Open Filename:= _
        "C:\Users\maison\Desktop\Smeto\Arbo.xlsx"

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

 Application.ScreenUpdating = False

 dl1 = arbo.Range("A" & Rows.Count).End(xlUp).Row
       arbo.Range("B2:C" & dl1).Copy eotp.Range("A8")
  Workbooks("Arbo.xlsx").Close

  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

Fonctionne sur mon pc,

Cordialement,

merci beaucoup

xorsankukai