XL 2019 vba couper recherche et coller

tanmyirt

XLDnaute Nouveau
Bonjour,

Je souhaite créer une macro en utilisant la fonction "Rechercher" et "copier"
Je voudrais que la valeur saisie dans B4; après le valide avec le bouton valide. soit couper et coller en bon endroit dans la feuille "tableau" en prend on consideration les deux critères de la "banque" et le "type"
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour tanmyirt, bienvenue sur XLD,

Voyez le fichier joint et la macro affectée au bouton :
VB:
Sub recherche()
Dim Banque$, xType As Range, Somme As Range, P As Range, n As Byte, lig As Variant, col As Variant
Banque = [B2]
Set xType = [B3:C3]
Set Somme = [B4:C4]
With Sheets("tableau")
    Set P = .[B5:R5,T5:AJ5] 'zones à adapter
    For n = 1 To 2
        lig = Application.Match(xType(n), .Columns(1), 0)
        col = Application.Match(Banque, P.Areas(n), 0)
        If IsNumeric(lig) And IsNumeric(col) Then _
            .Cells(lig, col + P.Areas(n).Column - 1) = Somme(n): Somme(n) = ""
    Next
End With
End Sub
Les valeurs de B4 et C4 sont collées.

A+
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour tanmyirt, le forum,
et ce que je peu ignorer et ne pas couper B4 ou C4 si vide.
Pas très clair mais c'est peut-être ceci que vous voulez :
VB:
Sub recherche()
Dim Banque$, xType As Range, Somme As Range, P As Range, n As Byte, lig As Variant, col As Variant
Banque = [B2]
Set xType = [B3:C3]
Set Somme = [B4:C4]
With Sheets("tableau")
    Set P = .[B5:R5,T5:AJ5] 'zones à adapter
    For n = 1 To 2
        lig = Application.Match(xType(n), .Columns(1), 0)
        col = Application.Match(Banque, P.Areas(n), 0)
        If IsNumeric(lig) And IsNumeric(col) And Somme(n) <> "" Then _
            .Cells(lig, col + P.Areas(n).Column - 1) = Somme(n): Somme(n) = ""
    Next
End With
End Sub
Bonne journée.
 

tanmyirt

XLDnaute Nouveau
bonjour, désolé pour le dérangement, est ce que je peux résumé le tableau dans une autre feuille et d etre facile à lire. sachant que il s'affiche juste les colonnes remplir. merci encore
 

job75

XLDnaute Barbatruc
Bonjour tanmyirt, le forum,

Pas besoin d'une autre feuille, la feuille "Tableau" suffit, voyez ce fichier (2) et le nouveau code :
VB:
Sub Valider()
Dim Banque$, xType As Range, Somme As Range, P As Range, n As Byte, lig As Variant, col As Variant, memcol(1 To 2)
Banque = [B2]
Set xType = [B3:C3]
Set Somme = [B4:C4]
With Sheets("Tableau")
    Set P = .[B5:R5,T5:AJ5] 'zones à adapter
    For n = 1 To 2
        lig = Application.Match(xType(n), .Columns(1), 0)
        col = Application.Match(Banque, P.Areas(n), 0)
        If IsNumeric(lig) And IsNumeric(col) And Somme(n) <> "" Then _
            .Cells(lig, col + P.Areas(n).Column - 1) = Somme(n): Somme(n) = "": memcol(n) = col + P.Areas(n).Column - 1
    Next
    If memcol(1) + memcol(2) Then
        If MsgBox("Valeurs enregistrées, voulez-vous afficher le résultat ?", 4) = 7 Then Exit Sub
        P.Columns.Hidden = True
        If memcol(1) Then .Columns(memcol(1)).Hidden = False
        If memcol(2) Then .Columns(memcol(2)).Hidden = False
        .Activate
    End If
End With
End Sub

Sub Afficher_tout()
Sheets("Tableau").Columns.Hidden = False
End Sub
PS : vous aviez mis des espaces avec les titres "Valide" et "Non valide", je les ai supprimés.

A+
 

Fichiers joints

tanmyirt

XLDnaute Nouveau
merci beaucoup pour votre réponse. mais il s affiche juste le dernier colonne et pas tout les colonnes remplies. merci
 

job75

XLDnaute Barbatruc
Oui on affiche uniquement les 2 colonnes de la banque choisie, c'est mieux si l'on veut corriger les dernières valeurs validées.

Et si l'on veut aussi masquer les lignes voyez ce fichier (2 bis) avec :
VB:
Sub Valider()
Dim Banque$, xType As Range, Somme As Range, P As Range, n As Byte, lig As Variant, col As Variant, mem(1 To 2, 1 To 2)
Banque = [B2]
Set xType = [B3:C3]
Set Somme = [B4:C4]
With Sheets("Tableau")
    Set P = .[B5:R5,T5:AJ5] 'zones à adapter
    For n = 1 To 2
        lig = Application.Match(xType(n), .Columns(1), 0)
        col = Application.Match(Banque, P.Areas(n), 0)
        If IsNumeric(lig) And IsNumeric(col) And Somme(n) <> "" Then _
            .Cells(lig, col + P.Areas(n).Column - 1) = Somme(n): Somme(n) = "": mem(n, 1) = col + P.Areas(n).Column - 1: mem(n, 2) = lig
    Next
    If mem(1, 1) + mem(2, 1) Then
        If MsgBox("Valeurs enregistrées, voulez-vous afficher le résultat ?", 4) = 7 Then Exit Sub
        P.Columns.Hidden = True
        P(1).CurrentRegion.Rows(3).Resize(P(1).CurrentRegion.Rows.Count - 4).Hidden = True
        If mem(1, 1) Then .Columns(mem(1, 1)).Hidden = False: .Rows(mem(1, 2)).Hidden = False
        If mem(2, 1) Then .Columns(mem(2, 1)).Hidden = False: .Rows(mem(2, 2)).Hidden = False
        .Activate
    End If
End With
End Sub

Sub Afficher_tout()
Sheets("Tableau").Columns.Hidden = False
Sheets("Tableau").Rows.Hidden = False
End Sub
 

Fichiers joints

tanmyirt

XLDnaute Nouveau
merci. mais te explique plus. a la fin de la saisie et par exemple je peux saisie 5 différent banque, je dois prendre les donnes de tableau et le saisie dans une autre application. et parce-que le tableau et grande je veux lire facilement me donnes, juste les banque que j'ai saisie. merci encore et désole pour le dérangement.
 

job75

XLDnaute Barbatruc
D'accord, voyez ce fichier (3) :
VB:
Sub Valider()
Dim Banque$, xType As Range, Somme As Range, P As Range, n As Byte, lig As Variant, col As Variant, flag As Boolean
Banque = [B2]
Set xType = [B3:C3]
Set Somme = [B4:C4]
With Sheets("Tableau")
    Set P = .[B5:R5,T5:AJ5] 'zones à adapter
    For n = 1 To 2
        lig = Application.Match(xType(n), .Columns(1), 0)
        col = Application.Match(Banque, P.Areas(n), 0)
        If IsNumeric(lig) And IsNumeric(col) And Somme(n) <> "" Then _
            .Cells(lig, col + P.Areas(n).Column - 1) = Somme(n): Somme(n) = "": flag = True
    Next
    If flag Then
        If MsgBox("Valeurs enregistrées, voulez-vous afficher le résultat ?", 4) = 7 Then Exit Sub
        Masquer
        .Activate
    End If
End With
End Sub

Sub Masquer()
Dim h&, r As Range
Set r = Sheets("Tableau").[B5:R5,T5:AJ5] 'zones à adapter
h = r(1).CurrentRegion.Rows.Count - 4
If h < 1 Then Exit Sub
For Each r In r
    r.EntireColumn.Hidden = Application.CountA(r(2).Resize(h)) = 0
Next
End Sub

Sub Afficher_tout()
Sheets("Tableau").Columns.Hidden = False
End Sub
 

Fichiers joints

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas