Transfert partiel de données

Bonjour à tous!

Je vous transmet mes deux classeurs Source et Destination, et demande votre aide pour le transfert de données du fichier source vers le fichier destination avec code VBA si possible.

Les données à transférer sont:

Colonne A: NO Devis ------------> Colonne A Num Devis

Colonne B: Client ------------------> Colonne D: Client

Colonne D Date Devis ----------> Colonne B: Date

Colonne G Article -----------------> Colonne H: Article

Colonne I: Quantite Devis -----> Colonne L: QTE DEVIS

Colonne K: Prix net HT ---------> M: PU HT

Colonne W:Representant -------> Q: Commercial

Le transfert se fera à chaque mise a jour du fichier source et à chaque transfert le fichier destination sera initialisé a zéro mais rien que pour les colonnes de destination.

merci à tous.

Salut Hosni,

Voilà ton code et tes deux fichiers avec le code dedans.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

Dim derligsource As Currency

'Numéro de ligne de la dernière ligne non vide du fichier source
derligsource = Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("A65536").End(xlUp).Row

Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("A2").Value = 1
derligdest = Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("A65536").End(xlUp).Row

If derligdest > 2 Then
'Initialisation du fichier destination
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("A2:A" & derligdest).Clear
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("D2:D" & derligdest).Clear
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("B2:B" & derligdest).Clear
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("H2:H" & derligdest).Clear
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("L2:L" & derligdest).Clear
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("M2:M" & derligdest).Clear
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("Q2:Q" & derligdest).Clear
Else

End If

'Boucle d'importation des données de source vers destination
For i = 2 To derligsource

Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("A" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("A" & i).Value
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("D" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("B" & i).Value
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("B" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("D" & i).Value
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("H" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("G" & i).Value
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("L" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("I" & i).Value
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("M" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("K" & i).Value
Workbooks("FICHIER DESTINATION.xlsx").Worksheets("DEVIS").Range("Q" & i).Value = _
Workbooks("FICHIER SOURCE.xlsm").Worksheets("001 ETAT DES DEVIS").Range("W" & i).Value

Next i

Application.ScreenUpdating = True

End Sub

Bon courage

Bonjour!

Salut Bastien62, merci pour votre réponse, dois mettre le code sur un bouton pour l’exécuter ou y t-il une autre méthode pour activer la macro.

Merci encore .

A bientôt.

Le code est déclenché par l’événement Worksheet_Change, donc a chaque fois qu'une modification à lieu sur la feuille 001 ETAT DES DEVIS la macro se lance, comme tu as demandé.

Salut Bastien62;

Je viens de faire un essai, cela marche à la perfection, est ce que je peux mettre le code dans un module pour l’exécuter via un bouton ?

Merci encore à vous et merci pour votre réactivité.

Oui bien sûr !

Salut Bastien62.

C'est parfait ainsi en plus de la première option.

Merci infiniment pour votre aide.

Sujet Clos, à bientôt

Cordialement

Je suis content que tu sois arrivé à ton objectif, bon courage !