Mettre a jour des données sur 2 fichiers (dont un est un sous-ensemble)

chjaffre

XLDnaute Nouveau
Bonsoir,
Je ne suis pas un expert loin de là en macro excel, je bute sur un problème sans doute basique.

J'utilise un fichier "Export_eureka" qui consolide les données de plusieurs fichiers, j'ai mis un exemple avec le fichier "EUREKA_Transfo".

Donc les données de "EUREKA_Transfo" sont un sous-ensemble de "Export_eureka".

Cependant, certaines cellules "EUREKA_Transfo" sont modifiées par des utilisateurs, notamment ( les colonnes suivantes S Q P C F Cotation Valid. Bravo), je ne trouve pas la solution pour mettre à jour le fichier consolidé "Export_eureka".

Je joins les 2 fichiers, ce sera plus clair. merci de votre aide. Ci-joint la macro que j'ai essayé de bidouiller.

Code :
Sub mise_a_jour_data_transfo()
Dim Cellule As Range
Dim data As Workbook
Dim base As Workbook
Dim LastLine As Integer
Dim Tableau1() As Variant
Dim Tableau2() As Variant
Dim i As Integer

' On ouvre le fichier Export_eureka et on lui donne le focus
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Consolidation" & "\" & "Export_eureka.xlsm"
Set data = ActiveWorkbook
data.Activate

' On cherche le numéro de la dernière ligne utilisée dans la colonne B
LastLine = Cells(Rows.Count, "B").End(xlUp).Row

' On redimensionne les 2 tableaux de façon dynamique
ReDim Tableau1(LastLine)
' On a besoin de stocker les valeurs de 8 colonnes
ReDim Tableau2(LastLine, 8)

' On charge le tableau avec les valeurs de la colonne B
For i = 3 To LastLine
Tableau1(i) = Range("B" & Trim(Str(i)))
Next i


' On active le fichier EUREKA_Transfo
Set base = ActiveWorkbook
base.Activate


' On scanne la colonne B avec les valeurs contenues dans le tableau
For i = 3 To LastLine
Set Cellule = ActiveSheet.Range("Ref").Find(Tableau1(i), lookat:=xlWhole)
Tableau2(i, 1) = Cellule.Offset(0, 12).Value
Tableau2(i, 2) = Cellule.Offset(0, 13).Value
Tableau2(i, 3) = Cellule.Offset(0, 14).Value
Tableau2(i, 4) = Cellule.Offset(0, 15).Value
Tableau2(i, 5) = Cellule.Offset(0, 16).Value
Tableau2(i, 6) = Cellule.Offset(0, 17).Value
Tableau2(i, 7) = Cellule.Offset(0, 18).Value
Tableau2(i, 8) = Cellule.Offset(0, 19).Value
Next i

' On active le fichier Export_eureka
Set data = ActiveWorkbook
data.Activate


' On recopie le contenu du tableau dans les colonnes N à U
For i = 3 To LastLine
Range("N" & Trim(Str(i))) = Tableau2(i, 1)
Range("O" & Trim(Str(i))) = Tableau2(i, 2)
Range("P" & Trim(Str(i))) = Tableau2(i, 3)
Range("Q" & Trim(Str(i))) = Tableau2(i, 4)
Range("R" & Trim(Str(i))) = Tableau2(i, 5)
Range("S" & Trim(Str(i))) = Tableau2(i, 6)
Range("T" & Trim(Str(i))) = Tableau2(i, 7)
Range("U" & Trim(Str(i))) = Tableau2(i, 8)
Next i

'On referme le classeur Export_eureka.xlsm dont on n'a plus besoin
Set data = ActiveWorkbook
data.Save


' On active le fichier EUREKA_Transfo
Set base = ActiveWorkbook
base.Activate
End Sub
 

Pièces jointes

  • Export_eureka.xlsm
    22.5 KB · Affichages: 30
  • EUREKA_Transfo.xlsm
    75.2 KB · Affichages: 34

Discussions similaires

Réponses
6
Affichages
239

Statistiques des forums

Discussions
312 196
Messages
2 086 084
Membres
103 116
dernier inscrit
kutobi87