Synchronisation + Ajout données VBA

Bonjour,

Je suis entrain de travailler sur un projet ; Et il me faut de l'aide s'il vous plait !

J'ai deux fichiers :

1) LISTE

2) DATA

Première partie je l'ai faite ; mais je ne sais pas si c'est possible de l'optimiser parce que je la trouve un peu Rikiki

Il faut trier et mettre à jour les données LISTE (à partir du fichier DATA) sur les colonnes 5 et 6 à condition que le numéro soit le même dans les deux fichiers .

Sub update()

LISTE = ActiveWorkbook.Name

'ouvrir le fichier data

Workbooks.Open Filename:= _
        "D:\Users\***\Documents\DATA.xlsx"    ' Le chemin du fichier

' Fichier visible
    ActiveWindow.Visible = True
' Vu que les données du fichier ne sont pas triées; on va procéder à un tri des données selon le NUMERO
' Le nombre de lignes du fichier DATA est variable
    Sheets("DATA").Range("A2").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        True, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        ' Le tri est effectué
'  rechercher le numéro dans chaque fichier afin de les croiser et faire la mise à jour

Data = ActiveWorkbook.Name

LastrowC = Workbooks(LISTE).Sheets("Liste").Cells.Find("*", ActiveSheet.Range("A1"), , , xlByRows, xlPrevious).Row
lastrowI = Workbooks(Data).Sheets("DATA").Cells.Find("*", ActiveSheet.Range("A1"), , , xlByRows, xlPrevious).Row

 For i = 2 To LastrowC

        For j = 2 To lastrowI

            If Workbooks(LISTE).Sheets("Liste").Cells(j, 1) = Workbooks(Data).Sheets("DATA").Cells(i, 1) Then

                        Workbooks(LISTE).Sheets("Liste").Cells(j, 5) = Workbooks(Data).Sheets("DATA").Cells(i, 5)
                        Workbooks(LISTE).Sheets("Liste").Cells(j, 6) = Workbooks(Data).Sheets("DATA").Cells(i, 6)

            End If

        Next j
    Next i

End Sub

Deuxième partie : Il faut ajouter les lignes du fichier DATA ((à condition qu'il n'existent pas auparavant dans le fichier LISTE ; Les lignes doivent s'ajouter sous les données existantes !

Les fichiers sont joints à mon message !

Merci

bonjour,

Hum.... Une solution :

Sub update()
Dim a, c, iRC, i, j, k, Y As Boolean, WbC As Workbook
Set WbC = ThisWorkbook
c = WbC.Sheets("Liste").Range("A1").CurrentRegion.Value
iRC = UBound(c) + 1

'ouvrir le fichier data
Workbooks.Open Filename:= _
        "D:\Users\***\Documents\TEST\DATA.xlsx"
a = ActiveWorkbook.Sheets("DATA").Range("A1").CurrentRegion.Value
ActiveWorkbook.Close

With WbC.Sheets("Liste")
 For i = 2 To UBound(a)
   For j = 2 To UBound(c)
            If a(i, 1) = c(j, 1) Then
               c(j, 5) = a(i, 5): c(j, 6) = a(i, 6)
               Y = True
            End If
        Next j
        If Not Y Then
            For k = 1 To 6
             .Cells(iRC, k) = a(i, k)
            Next
               iRC = iRC + 1
        End If
        Y = False
    Next i
    WbC.Sheets("Liste").Range("A1").Resize(UBound(c), 6) = c
End With
End Sub

(attention de remettre en place ton chemin de fichier !)

En cas de nécessité tu peux trier... après !

A+

C'EST PARFAIT !

Merci beaucoup Galopin01 !!!!

Très bonne soirée