Mise à jour d'un fichier TARGET excel depuis un autre SOURCE

Bonjour,

Soit un fichier SOURCE (onglet So)
Code Designation Data1 Data2
A 1 z g
B 2 e h
C 3 r j

Soit un fichier TARGET (onglet Ta)
Code Designation Data1 Data2 Data3
A 1 z f 1
B 0 b f 1

Je souhaite faire une mise à jour de TARGET en référence avec Code pour obtenir:
Code Designation Data1 Data2 Data3
A 1 z g 1
B 2 e h 1
C 3 r j 1

On remarquera que Data3 est figé à 1, une ligne est crée dans TARGET et les colonnes sont mises à jour avec les données de SOURCE.
Avez-vous une idée pour créer cette macro ?

Voila à quoi je pense:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub Worksheet_Activate() Dim i As Integer, j As Integer Application.ScreenUpdating = False With Sheets("SOURCE") For i = 3 To .Range("A1048576").End(xlUp).Row For j = 3 To Range("A1048576").End(xlUp).Row If Range("A" & j) = .Range("A" & i) Then Range("B" & j) = .Range("B" & i) Range("C" & j) = .Range("C" & i) Range("D" & j) = .Range("D" & i) Range("E" & j) = 1 End If Next j Next i End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub

Bonjour,

Je n'ai pas testé le code mais ça devrait être plus rapide:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
 
Private Sub Worksheet_Activate()
 
  Dim i As Integer
  Dim rngC As Range
 
  Application.ScreenUpdating = False
 
  With Worksheets("SOURCE")
    For i = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
 
      Set rngC = Columns(1).Find(.Cells(i, 1), , , xlWhole)
      If Not rngC Is Nothing Then
        Cells(rngC.Row, 2) = .Cells(i, 2)
        Cells(rngC.Row, 3) = .Cells(i, 3)
        Cells(rngC.Row, 4) = .Cells(i, 4)
        Cells(rngC.Row, 5) = 1
      End If
 
    Next i
  End With
 
End Sub

Et au cas ou plusieurs lignes du fichier 'TARGET' sont identiques:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Option Explicit
 
Private Sub Worksheet_Activate()
 
  Dim i As Integer
  Dim rngC As Range
  Dim strAdd As String
 
  Application.ScreenUpdating = False
 
  With Worksheets("SOURCE")
    For i = 3 To .Range("A" & .Rows.Count).End(xlUp).Row
 
      Set rngC = Columns(1).Find(.Cells(i, 1), , , xlWhole)
      If Not rngC Is Nothing Then
 
        strAdd = rngC.Address
        Do
          Cells(rngC.Row, 2) = .Cells(i, 2)
          Cells(rngC.Row, 3) = .Cells(i, 3)
          Cells(rngC.Row, 4) = .Cells(i, 4)
          Cells(rngC.Row, 5) = 1
          Set rngC = Columns(1).FindNext(rngC)
        Loop While rngC.Address <> strAdd
 
      End If
 
    Next i
  End With
 
End Sub

Pour le poste suivant, je me base sur la dernière macro:

Pour rappel TARGET et SOURCE sont les noms de fichiers
L'onglet de TARGET est So
L'onglet de SOURCE est Ta

J'ai l'erreur 9 à la ligne 11

Je ne vois pas comment prendre les données de SOURCE pour la mise à jour dans TARGET. On devrait activé les onglets ??

Et merci de s'y être intéressé.

Il faut remplacer:

Code:

With Worksheets("SOURCE")

Par:

Code:

With Workbooks("NOM DU CLASSEUR").Worksheets("Ta")

Avec le bon nom du classeur.

Ce code fonctionne si la macro est lancée avec la feuille "So" de sélectionnée.

Si je rajoute une variable temp et en mode debug pas à pas

Je modifie la boucle en ajoutant cette variable.
Code:

1 2 3 4 5 6 7 temp=.Cells(i,2) Cells(rngC.Row, 2) = .Cells(i, 2) Cells(rngC.Row, 3) = .Cells(i, 3) Cells(rngC.Row, 4) = .Cells(i, 4) Cells(rngC.Row, 5) = 1
Sur le fichier Target l'écriture en colonne 5 de 1 se fait correctement, alors que temp affiche aucune chaine de caractère sur toute la boucle.
Je n'arrive pas à extraire les données de Source.

Finalement la macro fonctionne pour la mise à jour.

Mais la ligne C 3 r j 1 n'est pas créée.

Voici le code:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit
 
Private Sub Worksheet_Activate()
 
  Dim i As Integer
  Dim rngC As Range
  Dim strAdd As String
 
 
 
  Application.ScreenUpdating = False
 
With Workbooks("Source.xlsm").Worksheets("So")
    For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
 
      Set rngC = Columns(1).Find(.Cells(i, 1), , , xlWhole)
      If Not rngC Is Nothing Then
 
        strAdd = rngC.Address
        Do
 
          Cells(rngC.Row, 2) = .Cells(i, 2)
          Cells(rngC.Row, 3) = .Cells(i, 3)
          Cells(rngC.Row, 4) = .Cells(i, 4)
          Cells(rngC.Row, 5) = 1
          Set rngC = Columns(1).FindNext(rngC)
        Loop While rngC.Address <> strAdd
 
      End If
 
    Next i
  End With
 
End Sub

La macro n'est pas prévue pour ajouter des lignes. Elle met à jour les lignes existantes par rapport au fichier source.

Chercher si des lignes existent dans le fichier 'source' mais pas dans le fichier 'target' n'est pas implémenté dans cette macro.

Merci, finalement j'ai trouvé.