XL 2016 [RESOLU] Copie entre 2 classeurs sous 2 conditions

[ivan27]

Bonjour à tous,

Pourriez-vous m'aider pour une extraction en VBA s'il vous plaît ?

En pièce jointe 2 classeurs

Si le numéro de la colonne A du classeur2 est identique au numéro de la colonne N du classeur1 et que la valeur de la colonne B du classeur2 est égale à "EMLCFM", alors je copie la date de la colonne C du classeur2 dans la colonne AD du classeur1

et

Si le numéro de la colonne A du classeur2 est identique au numéro de la colonne N du classeur1 et que la valeur de la colonne B du classeur2 est égale à "LIVCFM", alors je copie la date de la colonne C du classeur2 dans la colonne AE du classeur1

Merci d'avance pour votre aide et bonne fin de journée

Ivan

 

[Calvus]

Bonjour,

Ton fichier en retour.
Les 2 classeurs doivent être ouverts en même temps, sinon il faut faire autrement.

Option Explicit

Sub Extraire()
Application.ScreenUpdating = False
Dim t, t1, t2, i As Integer, j As Integer, k As Integer, m As Integer
Workbooks("classeur2 Ivan.xlsx").Activate
t = ActiveWorkbook.Sheets("extraction").Range("A2:C383")
ReDim t1(1 To UBound(t), 1 To UBound(t))
Workbooks("classeur1 Ivan.xlsm").Activate
[AO2].Resize(UBound(t, 1), 3) = t
    j = 1
        m = 1
For i = 1 To UBound(t)
    If Cells(i + 1, 42) = "EMLCFM" Then
        For k = 1 To UBound(t)
            If Cells(k + 1, 41) = Cells(m + 1, 14) Then
               t1(j, 1) = Cells(k + 1, 43)
                j = j + 1
                m = m + 1
            End If
        Next k
    End If
Next i
[AD2].Resize(UBound(t1, 1), 1) = t1

For i = 1 To UBound(t)
    If Cells(i + 1, 42) = "LIVCFM" Then
        If Application.CountIf(Range("n2:n23"), Cells(i + 1, 41)) Then
            Application.Index(Range("n2:n23"), Application.Match(Cells(i + 1, 41), Range("n2:n23"), 0), 1).Offset(, 17) = Cells(i + 1, 43)
        End If
    End If
Next i
[AO2].CurrentRegion.Delete
Application.ScreenUpdating = True
End Sub

A+

 

[ivan27]

Bonjour le forum, Calvus,
Calvus, merci beaucoup pour ta proposition.
J'ai une erreur lors de l'exécution du code :

t1(j, 1) = Cells(k + 1, 43) = <L'indice n'appartient pas à la sélection>

Bonne journée à tous
Ivan

 

[Calvus]

Bonjour,

Je suppose que le fichier n'est pas le même que celui de l'exemple...

Remplacer comme ceci :

t = ActiveWorkbook.Sheets("extraction").Range("A2:C" & Range("C" & Rows.Count).End(xlUp).Row)

Bonne journée

 

[ivan27]

Bonsoir le forum, Calvus,
Effectivement, le fichier n'était pas le même. J'ai pu adapter ta proposition en production.
Je te réitère mes remerciements.
Bonne soirée
Ivan