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"
 

Pièces jointes

  • recherche.xlsx
    17.5 KB · Affichages: 5

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+
 

Pièces jointes

  • recherche(1).xlsm
    26.2 KB · Affichages: 6

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.
 

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+
 

Pièces jointes

  • Recherche(2).xlsm
    27.8 KB · Affichages: 5

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
 

Pièces jointes

  • Recherche(2 bis).xlsm
    29.3 KB · Affichages: 4

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
 

Pièces jointes

  • Recherche(3).xlsm
    30 KB · Affichages: 11

Discussions similaires

Réponses
3
Affichages
506
Réponses
24
Affichages
1 K
Réponses
25
Affichages
1 K

Statistiques des forums

Discussions
311 720
Messages
2 081 912
Membres
101 837
dernier inscrit
Ugo