Importer certains données d'une feuille à une autre

anasimo

XLDnaute Occasionnel
Bonjour

(voir les images)
Capture1.JPG


-----------------

Capture2.JPG



je veux transférer uniquement les données des colonnes en fleches vers les colonnes dédiées de la feuille Crédit en reprenant uniquement ceux en bleu cad type 05 et de l'utilisateur 2566.

et si le lendemain je remplace les données sur la feuille BD…il doit importer le nouveaux données en les mettant après ceux déjà existant…cad il continue la suite de ce tableau



Si déja testé le filtre avancé...mais il efface les anciens données importés et les remplace par les nouveaux...et moi je veux garder aussi les anciens
 

Pièces jointes

  • import données.xlsx
    14.3 KB · Affichages: 12

job75

XLDnaute Barbatruc
Même s'il y a beaucoup d'utilisateurs, avec le Dictionary ça restera très rapide, fichier (3) :
VB:
Sub Importer()
Dim col1%, col2%, a, ub%, util, d As Object, i&, tablo, resu(), j%, v As Variant, n&
col1 = 1: col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
'---mémorise les utilisateurs---
util = Sheets("Utilisateurs").[A1].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(util)
    d(UCase(util(i, 1)) & Chr(1) & util(i, 2)) = ""
Next i
'---tableau des résultats---
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, a(ub))
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If d.exists(UCase(tablo(i, col1)) & Chr(1) & tablo(i, col2)) Then
        For j = 0 To ub
            v = tablo(i, a(j))
            If IsNumeric(v) Then resu(n, j) = CDbl(v) Else resu(n, j) = v
        Next j
        n = n + 1
    End If
Next i
'---restitution---
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With
'---RAZ---
With Sheets("BD")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .[A1].CurrentRegion.Offset(1).Delete xlUp
End With
End Sub
 

Pièces jointes

  • import données(3).xlsm
    24 KB · Affichages: 7

anasimo

XLDnaute Occasionnel
Même s'il y a beaucoup d'utilisateurs, avec le Dictionary ça restera très rapide, fichier (3) :
VB:
Sub Importer()
Dim col1%, col2%, a, ub%, util, d As Object, i&, tablo, resu(), j%, v As Variant, n&
col1 = 1: col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
'---mémorise les utilisateurs---
util = Sheets("Utilisateurs").[A1].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(util)
    d(UCase(util(i, 1)) & Chr(1) & util(i, 2)) = ""
Next i
'---tableau des résultats---
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, a(ub))
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If d.exists(UCase(tablo(i, col1)) & Chr(1) & tablo(i, col2)) Then
        For j = 0 To ub
            v = tablo(i, a(j))
            If IsNumeric(v) Then resu(n, j) = CDbl(v) Else resu(n, j) = v
        Next j
        n = n + 1
    End If
Next i
'---restitution---
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With
'---RAZ---
With Sheets("BD")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .[A1].CurrentRegion.Offset(1).Delete xlUp
End With
End Sub

you did a great job Mister job75 :) ....c'est exactement ce que je cherche. travail bien fini ....Merci beaucoup
Demain au bureau je vais l'adapter au fichier d'origine (qui comprend des noms des feuilles et de colonnes différentes. ...je viendrai vers vous en cas de soucis.
Encore une fois merci
 
Dernière édition:

job75

XLDnaute Barbatruc
Dans ce fichier (3 bis) on termine par un tri sur la colonne H :
VB:
'---restitution---
Application.ScreenUpdating = False
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    If n Then .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
    .[A1].CurrentRegion.Sort .Columns(8), xlAscending, Header:=xlYes 'tri sur la colonne H
End With
 

Pièces jointes

  • import données(3 bis).xlsm
    24.3 KB · Affichages: 8

anasimo

XLDnaute Occasionnel
you did a great job Mister job75 :) ....c'est exactement ce que je cherche. travail bien fini ....Merci beaucoup
Demain au bureau je vais l'adapter au fichier d'origine (qui comprend des noms des feuilles et de colonnes différentes. ...je viendrai vers vous en cas de soucis.
Encore une fois merci
bonjour Job75
Je veux ajouter une autre colonne de critères dans la feuille "utilisateurs"au lieu de deux prévue initialement (les colonnes concernées A,Bet C)

je cois que que la partie du code VBA concernée est....je ne sais pas comment l'adapter

Merci

'---mémorise les utilisateurs---
util = Sheets("Utilisateurs").[A4].CurrentRegion.Resize(, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(util)
d(UCase(util(i, 1)) & Chr(1) & util(i, 2)) = ""
Next i
 

job75

XLDnaute Barbatruc
Il faut préciser la colonne de la feuille "BD" où se trouve le 3ème critère.

Si c'est la colonne G (n° 7) on utilisera :
VB:
'---mémorise les utilisateurs---
util = Sheets("Utilisateurs").[A1].CurrentRegion.Resize(, 3)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(util)
    d(UCase(util(i, 1)) & Chr(1) & util(i, 2) & Chr(1) & util(i, 3)) = ""
Next i
'---tableau des résultats---
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, a(ub))
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If d.exists(UCase(tablo(i, col1)) & Chr(1) & tablo(i, col2) & Chr(1) & tablo(i, 7)) Then
'---
 

anasimo

XLDnaute Occasionnel
Il faut préciser la colonne de la feuille "BD" où se trouve le 3ème critère.

Si c'est la colonne G (n° 7) on utilisera :
VB:
'---mémorise les utilisateurs---
util = Sheets("Utilisateurs").[A1].CurrentRegion.Resize(, 3)
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(util)
    d(UCase(util(i, 1)) & Chr(1) & util(i, 2) & Chr(1) & util(i, 3)) = ""
Next i
'---tableau des résultats---
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, a(ub))
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If d.exists(UCase(tablo(i, col1)) & Chr(1) & tablo(i, col2) & Chr(1) & tablo(i, 7)) Then
'---
Non ça marche pas ...pour info j'ai pris l'avant dernier code que vous avez envoyé (ne tenant pas compte de tri) celui de #17.
je vous met en joint le fichier...et j'ai ajouté la 3ème colonne dans les critères (feuille utilisateurs colonne agences)
en fait la macro doit importer les lignes de la BD_CLMT vers CLMT en tenant compte compte de ces trois critères

NB: il doit importer par exemple une ligne qui contient 06GEN avec l'utilisateur 4014 et agence A10
 

Pièces jointes

  • BC_projet.xlsm
    25.9 KB · Affichages: 3

anasimo

XLDnaute Occasionnel
c'es

c'est juste que je l'ai mis au propre vers un fichier définitif avec les les noms des feuilles qu'on va utiliser durant notre tache.
Voila je vous ai mis le fichier en question (sur lequel vous avez travailler)

Rappel:
j'ai ajouté la 3ème colonne dans les critères (feuille utilisateurs qui concerne les agences à trier)
en fait la macro doit importer les lignes de la BD vers Crédit en tenant compte compte de ces trois critères

NB: il doit importer par exemple une ligne qui contient TER05 avec l'utilisateur 1254 et agence 632
 

Pièces jointes

  • import données(3).xlsm
    19.6 KB · Affichages: 3

anasimo

XLDnaute Occasionnel
Très bien alors maintenant faites 2 choses :

- complétez la plage A5:B10 de la feuille "Utilisateurs"

- modifiez la macro comme je l'ai indiqué au post #20.
Non on ne doit pas raisonner avec la plage....mais les critères présents dans les 3 colonnes...car la colonne agences va contenir une centaine de numéro d'agence
Il se peut que le fichier source (chargé quotidiennement) contient dans journée qu'une dizaine d'agence et lendemain une vingtaine
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG