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

anasimo

XLDnaute Junior
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
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonsoir anasimo,

Pas vraiment clair en ce qui concerne les lignes à copier.

Sur votre fichier feuille "BD" on copie bien sûr les lignes 2-7-8-12 qui ont 2 cellules colorées en bleu.

Mais faut-il aussi copier les lignes 3-4-10-11 qui n'ont qu'une cellule colorée en bleu ?

A+
 

anasimo

XLDnaute Junior
Bonsoir anasimo,

Pas vraiment clair en ce qui concerne les lignes à copier.

Sur votre fichier feuille "BD" on copie bien sûr les lignes 2-7-8-12 qui ont 2 cellules colorées en bleu.

Mais faut-il aussi copier les lignes 3-4-10-11 qui n'ont qu'une cellule colorée en bleu ?

A+
Merci pour ta réponse....je vais expliquer plus.

sur la BD je veux faire des filtres sur TER05 de la colonne A et 2566 sur la colonne J ....le résultat sera exporté (mais pas toutes les colonnes mais juste ceux mentionnées sur la feuille crédit. ...voir image

Capture3.JPG

........


pour avoir
Capture4.JPG



aussi si le lendemain il y a une nouvelle BD quand j'exporte ils doivent s'ajouter à la ligne suivante et ainsi de suite
 
Dernière édition:

job75

XLDnaute Barbatruc
Ma question est pourtant claire mais vous n'y répondez pas vraiment.

En supposant qu'on importe uniquement les lignes où les 2 critères sont vérifiés voyez cette macro dans le fichier joint :
VB:
Sub Importer()
Dim crit1$, col1%, crit2$, col2%, a, ub%, tablo, resu(), i&, n&, j%, v As Variant
crit1 = "TER05": col1 = 1 'à adapter
crit2 = "2566": col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, 14)
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If UCase(tablo(i, col1)) = crit1 And CStr(tablo(i, col2)) = crit2 Then '2 critères vérifiés
        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
If n = 0 Then Exit Sub
'---restitution---
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Cells(.Rows.Count, 4).End(xlUp)(2).Resize(n, ub + 1) = resu
End With
End Sub
A+
 

Fichiers joints

job75

XLDnaute Barbatruc
La macro est très rapide car elle utilise des tableaux VBA.

Pour tester j'ai recopié le tableau de la feuille "BD" sur 104 000 lignes.

Chez moi sur Win 10 - Excel 2019 j'obtiens le résultat en 0,47 seconde.
 

anasimo

XLDnaute Junior
La macro est très rapide car elle utilise des tableaux VBA.

Pour tester j'ai recopié le tableau de la feuille "BD" sur 104 000 lignes.

Chez moi sur Win 10 - Excel 2019 j'obtiens le résultat en 0,47 seconde.
Merci infiniment job...ça marche c'est exactement ce que je veux
Juste pour perfectionner le fichier au lieu d’incrémenter les critères de filtre dans la macro je veux qu'il vient les chercher dans une feuille nommée "Utilisateurs" (car on est amené à chaque fois de changer les numéro des utilisateurs)
voir image

Capture5.JPG

NB: dans la feuille BD j'ai modifié le nom de la colonne J par "utilisateur" au lieu de données 10

Merci de votre aide
 

job75

XLDnaute Barbatruc
Bonjour anasimo, le forum,

Et que voulez-vous que je fasse avec les numéros d'utilisateurs ?

En attendant voyez ce fichier (1 bis) qui utilise le filtre avancé puisque vous en parliez :
VB:
Sub Importer()
Dim ad1$, ad2$, a, ncol%, dest As Range, i%
Application.ScreenUpdating = False
ThisWorkbook.Names.Add "Crit1", "TER05": ThisWorkbook.Names.Add "Crit2", "=""2566""" 'noms définis à adapter
ad1 = "A2": ad2 = "J2" 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
With Sheets("Crédit")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set dest = .Cells(.Rows.Count, 4).End(xlUp)(2)
End With
With Sheets("BD").[A1].CurrentRegion
    ncol = .Columns.Count
    .Cells(2, ncol + 2) = "=AND(Crit1=" & ad1 & ",Crit2=" & """""&" & ad2 & ")" 'zone de critères
    .AdvancedFilter xlFilterInPlace, .Cells(1, ncol + 2).Resize(2)
    For i = 0 To UBound(a)
        .Columns(a(i)).Copy dest.Offset(, i)
    Next
    dest.Resize(, UBound(a) + 1).Delete xlUp 'supprime les titres
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    .Cells(2, ncol + 2) = ""
End With
End Sub
Les formats sont copiés, du coup les nombres sous forme de textes ne sont pas convertis.

Et avec un tableau de 104 000 lignes la macro s'exécute en 7,2 secondes...

Bon dimanche.
 

Fichiers joints

anasimo

XLDnaute Junior
merci...oui il est bien fait...il marche aussi....mais juste une chose je veux qu'une fois les données importées le fichier source doit s'effacer...car à chaque fois je clique sur le bouton il les importe (risque de doublons)
 

anasimo

XLDnaute Junior
pour les numéros des utilisateurs (il s'agit en fait de la matricule de la personne qui a saisi les données dans le système )...à tout moment ils sont amenés à être modifiés ou changés ou ajouter d'autres utilisateurs (cette fois c'était 2566...mais la prochaine il se peut que je le change par 5412 ou garder les deux...et ainsi de suite) cad je dois renseigner dans la colonne B de la feuille "utilisateurs" les numéros que des utilisateurs que je veux )
 

job75

XLDnaute Barbatruc
Voyez ce fichier (2) :
VB:
Sub Importer()
Dim crit1$, crit2$, col1%, col2%, a, ub%, tablo, resu(), i&, n&, j%, v As Variant
With Sheets("Utilisateurs").[A1].CurrentRegion
    crit1 = CStr(.Cells(.Rows.Count, 1))
    crit2 = CStr(.Cells(.Rows.Count, 2))
End With
col1 = 1: col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, 14)
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If UCase(tablo(i, col1)) = crit1 And CStr(tablo(i, col2)) = crit2 Then '2 critères vérifiés
        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
 

Fichiers joints

anasimo

XLDnaute Junior
Voyez ce fichier (2) :
VB:
Sub Importer()
Dim crit1$, crit2$, col1%, col2%, a, ub%, tablo, resu(), i&, n&, j%, v As Variant
With Sheets("Utilisateurs").[A1].CurrentRegion
    crit1 = CStr(.Cells(.Rows.Count, 1))
    crit2 = CStr(.Cells(.Rows.Count, 2))
End With
col1 = 1: col2 = 10 'à adapter
a = Array(2, 3, 5, 6, 10, 12, 14) 'numéros des colonnes à copier
ub = UBound(a)
tablo = Sheets("BD").[A1].CurrentRegion.Resize(, 14)
ReDim resu(UBound(tablo), ub) 'base 0
For i = 2 To UBound(tablo)
    If UCase(tablo(i, col1)) = crit1 And CStr(tablo(i, col2)) = crit2 Then '2 critères vérifiés
        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
Parfait ...il répond à 97% de mes attentes ...manque juste pour la ligne de critère ...vous avez utiliser La dernière ligne pour les critères...alors qu'il faut utiliser toute la plage de A1:B4 de la feuille utilisateurs (il se peut qu'il y aura plusieurs utilisateurs à insérer)....et merci beaucoup
 

anasimo

XLDnaute Junior
mon tableau source est alimenté quotidiennement (c'est un fichier édité sous format excel d'un autre SI) il comprend plus de 2000 lignes) donc du tableau source, je dois importer les lignes qui contiennent en même temps le type TER05 et les utilisateurs renseignés dans la colonne utilisateurs (il se peut que le lendemain je modifie les numéros utilisateurs et mettre d'autres..et il doit importé le type TER05 avec les nouveaux numéros que j'ai renseigné...)
Capture11.JPG

pour notre exemple il va importer tous les TER05 et les utilisateurs 5412; 1236 et 2566............si le lendemain je met dans la colonne B de nouveaux numéro par exemple (1005, 2631,...) il doit les chercher
 

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
 

Fichiers joints

anasimo

XLDnaute Junior
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
 

Fichiers joints

anasimo

XLDnaute Junior
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
'---
 

Discussions similaires


Haut Bas