Recherchev sur plusieurs lignes

11exemple.xlsx (17.49 Ko)

Bonjour à tous,

Etant nouvelle en codage, je me permets de vous solliciter pour m'aider à créer une macro.

J'aimerais créer une macro qui s'active dès lors qu'on appuie sur le bouton "Générer un gabarit".

Cette macro me permettrais :

- de générer un nouveau fichier excel reprenant l'ensemble des données de la feuille "Tableau recap"

- tout en modifiant les données de la colonne "user" et "direction" en code (via une rechercheV)

Pouvez-vous m'aider ?

Voici ce que j'ai pour générer un nouveau fichier

Sub GABARIT()

Dim Chemin As String
Dim Fichier As String



Chemin = "xx\\\"
Fichier = InputBox("Nom du fichier") & ".xlsm"
ActiveWorkbook.SaveCopyAs Chemin & Fichier

End Sub

A voir si je ne peux pas implémenter une rechercherv avant la copie du fichier là où se trouve

Bonjourn

Essayez ceci:

Sub GABARIT()
    'déclaration des variables
    Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet
    Dim Chemin As String, Fichier As String
    Dim DerLig_f1 As Long, DerLig_f2 As Long, DerLig_f3 As Long

    Application.ScreenUpdating = False 'supprime les rafraîchissements de l'écran et accélère l'exécution de la macro

    'affectation d'une variable pour chaque feuille
    Set f1 = Sheets("Tableau recap")
    Set f2 = Sheets("User")
    Set f3 = Sheets("Direction")

    'recherche des dernières lignes de chaque feuille
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f3 = f3.Range("A" & Rows.Count).End(xlUp).Row

    'on fait une copie des valeurs de C et D vers I et J
    f1.Range("C2:D" & DerLig_f1).Copy f1.Range("I2")
    'application des formules rechercheV
    f1.Range("C2:C" & DerLig_f1).FormulaR1C1 = "=VLOOKUP(RC[6]," & f2.Name & "!C[-2]:C[-1],2,0)"
    f1.Range("D2:D" & DerLig_f1).FormulaR1C1 = "=VLOOKUP(RC[6]," & f3.Name & "!C[-3]:C[-2],2,0)"
    'on remplace les résultats obtenus par formule, par leurs valeurs respectives
    f1.Range("C2:D" & DerLig_f1).Value = f1.Range("C2:D" & DerLig_f1).Value

    'Sauvegarde
    Chemin = "xx\\\"
    Fichier = InputBox("Nom du fichier") & ".xlsm"
    ActiveWorkbook.SaveCopyAs Chemin & Fichier

    'on remet les valeurs d'origine en C et D
    f1.Range("I2:J" & DerLig_f1).Copy f1.Range("C2")
    f1.Range("I2:J" & DerLig_f1).ClearContents 'on efface les valeurs déplacées en I et J

    'on libère la mémoire
    Set f1 = Nothing
    Set f2 = Nothing
    Set f3 = Nothing
End Sub

Cdlt

Rechercher des sujets similaires à "recherchev lignes"