Discussion :

[breweryfr]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[breweryfr]

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é.

[Invité]

Il faut remplacer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Worksheets("SOURCE")

Par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[breweryfr]

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

Je modifie la boucle en ajoutant cette variable.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[breweryfr]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

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.

[breweryfr]

Merci, finalement j'ai trouvé.