XL 2010 COPIER / COLLER D'UN FICHIER A UN AUTRE AVEC MULTI CRITÈRES

lacamioneta · 19 Avril 2018

Bonjour,

Une fois n'est pas coutume, je sèche à trouver une solution à ma problématique,
j'ai bien un code qui fonctionne, mais ne fait pas tout ce que je voudrais qu'il fasse
Je m'explique:

Il y a 2 fichiers: un fichier "source" qui vient d'un extract hebdomadaire et un fichier "stock" sur lequel je je veux récupérer unique des lignes du fichier "source" qui m’intéresse.
Les lignes qui m'intéressent sont celles qui ont le même n° d'article défini dans le fichier "stock" feuille " stock".
Le problème dans mon code, est que je n'arrive pas à choisir toute la liste d'article que je veux en critère

Je fais appel à votre bon cœur, pour m'aider à résoudre ce problème
merci

VB:

Sub Copysource()
Dim source As Workbook, stock_test1 As Workbook
Dim Rw As Range
Dim lgn As Long
Dim i As Long
'ouvrir le classeur source (en lecture seule)
Chemin = ThisWorkbook.Path
'définir le classeur destination
Set stock_test1 = ThisWorkbook
Set source = Application.Workbooks.Open("C:\********\source.xlsx")
For Each Rw In Workbooks("source.xlsx").Sheets("Feuil1").Range("A2:A200000")
    If Rw.Value = Workbooks("stock_test1.xlsm").Sheets("stock").Range("A4") Then
            Rw.EntireRow.Copy Destination:=Workbooks("stock_test1.xlsm").Sheets("extract").Range("A1")
            lgn = ligne + 1
    End If
Next Rw
'fermer le classeur source
source.Close False
If MsgBox("Copie Finie", vbYes, "Mise à jour stock") = vbYes Then
  End If

Lone-wolf · 20 Avril 2018

Bonjour Macamioneta

Je viens d'ouvrir les classeurs, ce ne serait pas le classeur "stock" le fichier source?? Parce-que dans le classeur "Source" je vois plein de doublons. En attendant

VB:

Sub Copysource()
Dim Fichier$, WbSource As Workbook, WbStock As Workbook
Dim derlig&, x&, plage As Range, cel As Range, critere
     
    'définir le classeur destination
    Fichier = ThisWorkbook.Path & "\source.xlsx"
 
      'définir le classeur source
    Set WbSource = Application.Workbooks.Open(Fichier)

    x = 3
    derlig = WbSource.Sheets("Feuil1").Range("a" & Rows.Count).End(xlUp).Row
    plage = WbSource.Sheets("Feuil1").Range("a2:a" & derlig)
    Set WbStock = ThisWorkbook
    'Ici il te faut créer une liste déroulante avec les numéro d'article sans doublons
     critere = WbStock.Sheets("stock").Range("m3")

    Set cel = plage.Find(critere, , xlValues)

    If Not cel Is Nothing Then
        premaddress = cel.Address
        Do
            x = x + 1

            With WbStock.Sheets("extract")
                .Range("a" & x) = cel.Offset(0, 0).Value         'n° article
                .Range("b" & x).Value = cel.Offset(0, 1).Value   'en magasin
                .Range("c" & x).Value = cel.Offset(0, 2).Value   'en production
                .Range("d" & x).Value = cel.Offset(0, 3).Value   'autre
            End With
            Set cel = plage.FindNext(cel)
        Loop While Not cel Is Nothing And cel.Address <> premaddress
    End If
source.Close False
MsgBox "Copie Finie", , "Mise à jour stock"
End Sub

lacamioneta · 24 Avril 2018

Bonjour Lone-wolf

tout d'abord merci,
non c'est bien le fichier source à partir duquel je veux copier les valeurs à coller dans le fichier stock
mais en tout cas j'ai compris le principe de ton code, je l'ai adapté et cela fonctionne

encore merci!!!!!

XL 2010 COPIER / COLLER D'UN FICHIER A UN AUTRE AVEC MULTI CRITÈRES

lacamioneta

XLDnaute Nouveau

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

lacamioneta

XLDnaute Nouveau

Discussions similaires