Recherche de valeurs et copier sur un autre classeur Résolu

Question

Bonjour, 

J'ai un premier classeur (rapport journalier du logiciel de gestion) qui me donne les ventes du jour :
Avec plusieurs colonne dont :  Référence   Quantité   CA        etc...
Sur ce rapport il n'y a que les réf vendues du jour, que je doit reporter sur un autre classeur où ce trouve toutes les références.
Donc je voudrais une macro automatisant cela. 
En espérant être compris ;-)
Merci de me m'aiguiller dans mes recherche car je ne trouve pas les bonnes questions à poser.

https://www.cjoint.com/c/FCBouuYSK5c

Configuration: Windows 7 / Chrome 49.0.2623.87

via55 · Answer

Bonsoir Remifasol

1) Corriger tous les codes dans la feuille du classeur cible (TA, TB ...) ils doivent être écrits sans espace après, ce qui n'est pas la cas de tous pour l'instant) sinon la macro ne pourra pas fonctionner

2) Les 2 classeurs étant ouverts , copier-coller la macro ci-dessous dans un module de l'éditeur VBA du classeur source puis modifier si nécessaire les noms de classeurs et de feuilles en début de macro

Sub transfert()
Dim Ligne As Long, ligneC As Long

' MODIFIER DANS LA MACRO LES NOMS DES CLASSEURS ET DES FEUILLES SI NECESSAIRE
'nom du classeur source
ws = "H1211.xlsm"
'nom feuille source
Fs = "Source"
'nom classeur cible
wc = "CIBLE.xlsx"
'nom feuille cible
Fc = "Cible"

' dernière ligne remplie colonne J de Source
Ligne = Workbooks(ws).Sheets(Fs).Columns(10).Find("*", , , , xlByColumns, xlPrevious).Row
'boucle sur les lignes de Source
For n = 5 To Ligne
' recupere 2 lettres à gauche du code
codlig = Left(Workbooks(ws).Sheets(Fs).Range("J" & n), 2)
'recupere la lettre à droite du code
codcol = Right(Workbooks(ws).Sheets(Fs).Range("J" & n), 1)
' ligne en col A de Cible ou se retrouve les 1 premieres lettres du code
ligneC = Workbooks(wc).Sheets(Fc).Columns(1).Find(codlig, , , , xlByColumns, xlPrevious).Row
' colonne des codes dans Cible en focntion DU B ou P du code
If codcol = "B" Then col = 1 Else col = 6
'transfert des données de Source à Cible
Workbooks(wc).Sheets(Fc).Cells(ligneC, col + 1) = Workbooks(ws).Sheets(Fs).Range("K" & n)
Workbooks(wc).Sheets(Fc).Cells(ligneC, col + 2) = Workbooks(ws).Sheets(Fs).Range("N" & n)
Workbooks(wc).Sheets(Fc).Cells(ligneC, col + 3) = Workbooks(ws).Sheets(Fs).Range("X" & n)
Next n

End Sub

3) Les 2 classeurs ouverts lancer la macro

Cdlmnt
Via

ReMiFaSol · Answer

Impec ! Merci

Recherche de valeurs et copier sur un autre classeur

2 réponses

Discussions similaires

Newsletters