Recherchev sur plusieurs lignes
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