COPIER ET COLLER LA VALEUR D'1 TABLEAU EN FONCTION D'1 AUTRE

Bonjour à tout le forum,

J'ai écris un code VBA qui me permet de remplir un tableau excel à l'aide d'un autre.

Ce code me permet de remplir les colonnes A et B du tableau 1 (essai lit tablo cible.xlsx)

Si la valeur de la colonne C du tableau 1 est égale à la valeur de la colonne A du tableau 2 (essai lit tablo source.xlsx),

alors Colonne A du tabeau 1 = colonne C du tableau 2

et Colonne B du tabeau 1 = colonne D du tableau 2

Le code fonctionne, mais l'exécution dure 20 min.

ma question est comment pourrais-je faire pour réduire cette durée?

Merci de votre aide.

ci-dessous le code :

Sub test()
Application.ScreenUpdating = False
Application.Visible = False

Dim ClasseurClible, ClasseurSource As Workbook
Dim PlageSource, PlageCible As Range
Dim CellSource, CellCible As Range

Set ClasseurSource = Workbooks.Open(Filename:="Bureau\essai lit tablo source.xlsx", ReadOnly:=True)
ClasseurSource.Worksheets(1).Activate
Set PlageSource = Range("A2", Range("A2").End(xlDown))
Worksheets(1).Activate
Set PlageCible = Range("C2", Range("C2").End(xlDown))
For Each CellCible In PlageCible
For Each CellSource In PlageSource
If CellCible = CellSource Then
CellCible.Offset(, -1).Value = CellSource.Offset(, 3).Value
CellCible.Offset(, -2).Value = CellSource.Offset(, 2).Value
End If
Next
Next

Application.ScreenUpdating = True
Application.Visible = True
End Sub

ci-joint fichier 2

Bonjour,

A tester.

Option Explicit
Public Sub test()
Dim calcState As Integer
Dim eventsState As Boolean, screenUpdateState As Boolean, statusBarState As Boolean
Dim ClasseurCible As Workbook, ClasseurSource As Workbook
Dim PlageSource As Range, PlageCible As Range
Dim CellSource As Range, CellCible As Range
'--------------------------------------------------------------------------------------------------------
    On Error GoTo gestion_erreur
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    calcState = Application.Calculation
    eventsState = Application.EnableEvents

    With Application
        .Calculation = xlCalculationManual
        .DisplayStatusBar = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With
'--------------------------------------------------------------------------------------------------------
    Set ClasseurCible = ActiveWorkbook

    Set ClasseurSource = Workbooks.Open(Filename:="Bureau\essai lit tablo source.xlsx", ReadOnly:=True)
    ClasseurSource.Worksheets(1).Activate
    Set PlageSource = Range("A2", Range("A2").End(xlDown))

    ClasseurCible.Worksheets(1).Activate
    Set PlageCible = Range("C2", Range("C2").End(xlDown))
    For Each CellCible In PlageCible
        For Each CellSource In PlageSource
            If CellCible = CellSource Then
                CellCible.Offset(, -1).Value = CellSource.Offset(, 3).Value
                CellCible.Offset(, -2).Value = CellSource.Offset(, 2).Value
            End If
        Next
    Next
'--------------------------------------------------------------------------------------------------------
With Application
        .Calculation = calcState
        .DisplayStatusBar = statusBarState
        .EnableEvents = eventsState
        .ScreenUpdating = screenUpdateState
    End With
'--------------------------------------------------------------------------------------------------------
gestion_erreur:
    With Application
        .Calculation = calcState
        .DisplayStatusBar = statusBarState
        .EnableEvents = eventsState
    End With

End Sub

Bonjour Jean Eric et merci d'avoir pris le temps de répondre.

J'ai testé ton code, mais j'ai dû l'interrompre car ça met au moins 15 min

Re,

Je n'ai pas réellement testé ton code.

J'ai tenté de l'optimiser. Combien de lignes respectives comportent tes fichiers?

Cdlt.

Jean eric, en fonction des semaines, le tableau cible peut faire entre 15 000 et 18 000 lignes

et le tableau source fait environ 8500 lignes