Macro, excel, rechercher une valeur
Résolu
Bonjour,
Je souhaiterai rechercher une valeur dans une feuille et la mettre dans une autre.*Mon problème aujourd'hui c'est que cette valeur n'est pas toujours sur la même ligne. Je m'explique :
La feuille ou je veux récuperer la valeur change tous les mois, donc je la change automatiquement via ma macro et de ce fait des lignes peuvent être rajoutée et ma valeur chercher decalé.
J'avais pensé utilisé :
.formulalocal ="=Recherchev("TOTAL";A:A;18)
seulement comme TOTAL peut varier de ligne suivant les mois cela ne fonctionne pas!
J'essai avec .Find mais je n'arrive à aucun résultat.
Clairement, je souhaiterai pouvoir récuperer une valeur dont la colonne ne change jamais mais la ligne change, par contre la valeur de ma 1ère colonne de la ligne qui m'intéresse ne change jamais c'est "TOTAL"
Es ce quelqu'un pourrait m'aider je suis perdu...
Sub Gest()
'Activation du fichier
classeur1 = ActiveWorkbook.Name
Workbooks("" & classeur1 & "").Activate
'X = n° de chantier
X = Sheets("Données").Range("B1")
'Suppression ancienne feuille de gestion
Application.DisplayAlerts = False
Sheets("feuille de gestion").Delete
Application.DisplayAlerts = True
'Ouverture de la feuille de gestion sur le Serveur Progib
Workbooks.Open "\\192.168.1.3\chantier\snee\" & X & "\" & X & ".xls"
'Activation feuille de gestion et copie dans le découpage
Workbooks("" & X & ".xls").Activate
Workbooks("" & X & ".xls").Sheets("Feuil1").Copy Before:=Workbooks("" & classeur1 & "").Sheets("GENERAL")
Workbooks("" & classeur1 & "").Activate
'Renomme la feuille de gestion
Sheets("Feuil1").Name = ("feuille de gestion")
'fermeture de la feuille de gestion du serveur Progib
Workbooks("" & X & ".xls").Close False
'Remplissage des cases dans le Gestion
Y = Sheets("feuille de gestion").Range("AD9")
Worksheets("Gestion").Range("I6") = Y
W = Range("S65536").End(xlUp).Offset(0, 0)
Worksheets("Gestion").Range("D5") = W
Z = Sheets("PRimes").Range("D24")
Worksheets("Gestion").Range("D27") = Z * 2
O = Range("R65536").End(xlUp).Offset(0, 0)
M = Sheets("Gestion").Range("D7")
N = Sheets("Gestion").Range("D9")
P = Sheets("Gestion").Range("D19")
Q = Sheets("Gestion").Range("D25")
Worksheets("Gestion").Range("J35") = O + M + N + P + Q
'R = Sheets("feuille de gestion").Range("J9")
'S = Sheets("feuille de gestion").Range("R9")
'Worksheets("Gestion").Range("I33") = R
'Worksheets("Gestion").Range("I35") = S
Worksheets("Gestion").Range("I33").FormulaLocal = "=RECHERCHEV('Données'!H1;'feuille de gestion'!A3:AJ37;1)"
Worksheets("Gestion").Range("I35").FormulaLocal = "=RECHERCHEV('Données'!H1;'feuille de gestion'!A3:AJ37;1)"
T = Range("J65536").End(xlUp).Offset(0, 0)
U = Range("I65536").End(xlUp).Offset(0, 0)
Worksheets("GS MO").Range("B4") = T / U
V = Sheets("feuille de gestion").Range("AE4")
Worksheets("Gestion").Range("L10") = V
Worksheets("GS MO").Range("B7") = T
End Sub
Je souhaiterai rechercher une valeur dans une feuille et la mettre dans une autre.*Mon problème aujourd'hui c'est que cette valeur n'est pas toujours sur la même ligne. Je m'explique :
La feuille ou je veux récuperer la valeur change tous les mois, donc je la change automatiquement via ma macro et de ce fait des lignes peuvent être rajoutée et ma valeur chercher decalé.
J'avais pensé utilisé :
.formulalocal ="=Recherchev("TOTAL";A:A;18)
seulement comme TOTAL peut varier de ligne suivant les mois cela ne fonctionne pas!
J'essai avec .Find mais je n'arrive à aucun résultat.
Clairement, je souhaiterai pouvoir récuperer une valeur dont la colonne ne change jamais mais la ligne change, par contre la valeur de ma 1ère colonne de la ligne qui m'intéresse ne change jamais c'est "TOTAL"
Es ce quelqu'un pourrait m'aider je suis perdu...
Sub Gest()
'Activation du fichier
classeur1 = ActiveWorkbook.Name
Workbooks("" & classeur1 & "").Activate
'X = n° de chantier
X = Sheets("Données").Range("B1")
'Suppression ancienne feuille de gestion
Application.DisplayAlerts = False
Sheets("feuille de gestion").Delete
Application.DisplayAlerts = True
'Ouverture de la feuille de gestion sur le Serveur Progib
Workbooks.Open "\\192.168.1.3\chantier\snee\" & X & "\" & X & ".xls"
'Activation feuille de gestion et copie dans le découpage
Workbooks("" & X & ".xls").Activate
Workbooks("" & X & ".xls").Sheets("Feuil1").Copy Before:=Workbooks("" & classeur1 & "").Sheets("GENERAL")
Workbooks("" & classeur1 & "").Activate
'Renomme la feuille de gestion
Sheets("Feuil1").Name = ("feuille de gestion")
'fermeture de la feuille de gestion du serveur Progib
Workbooks("" & X & ".xls").Close False
'Remplissage des cases dans le Gestion
Y = Sheets("feuille de gestion").Range("AD9")
Worksheets("Gestion").Range("I6") = Y
W = Range("S65536").End(xlUp).Offset(0, 0)
Worksheets("Gestion").Range("D5") = W
Z = Sheets("PRimes").Range("D24")
Worksheets("Gestion").Range("D27") = Z * 2
O = Range("R65536").End(xlUp).Offset(0, 0)
M = Sheets("Gestion").Range("D7")
N = Sheets("Gestion").Range("D9")
P = Sheets("Gestion").Range("D19")
Q = Sheets("Gestion").Range("D25")
Worksheets("Gestion").Range("J35") = O + M + N + P + Q
'R = Sheets("feuille de gestion").Range("J9")
'S = Sheets("feuille de gestion").Range("R9")
'Worksheets("Gestion").Range("I33") = R
'Worksheets("Gestion").Range("I35") = S
Worksheets("Gestion").Range("I33").FormulaLocal = "=RECHERCHEV('Données'!H1;'feuille de gestion'!A3:AJ37;1)"
Worksheets("Gestion").Range("I35").FormulaLocal = "=RECHERCHEV('Données'!H1;'feuille de gestion'!A3:AJ37;1)"
T = Range("J65536").End(xlUp).Offset(0, 0)
U = Range("I65536").End(xlUp).Offset(0, 0)
Worksheets("GS MO").Range("B4") = T / U
V = Sheets("feuille de gestion").Range("AE4")
Worksheets("Gestion").Range("L10") = V
Worksheets("GS MO").Range("B7") = T
End Sub
3 réponses
-
Bonjour,
Je vous remercie tous les 2! Mais hier soir j'ai travailler dur et j'ai réussi !! Je vous envoie mon code :Sub Gest() 'Activation du fichier classeur1 = ActiveWorkbook.Name Workbooks("" & classeur1 & "").Activate 'X = n° de chantier X = Sheets("Données").Range("B1") 'Suppression ancienne feuille de gestion Application.DisplayAlerts = False Sheets("feuille de gestion").Delete Application.DisplayAlerts = True 'Ouverture de la feuille de gestion sur le Serveur Progib Workbooks.Open "\\192.168.1.3\chantier\snee\" & X & "\" & X & ".xls" 'Activation feuille de gestion et copie dans le découpage Workbooks("" & X & ".xls").Activate Workbooks("" & X & ".xls").Sheets("Feuil1").Copy Before:=Workbooks("" & classeur1 & "").Sheets("GENERAL") Workbooks("" & classeur1 & "").Activate 'Renomme la feuille de gestion Sheets("Feuil1").Name = ("feuille de gestion") 'fermeture de la feuille de gestion du serveur Progib Workbooks("" & X & ".xls").Close False 'Remplissage des cases dans le Gestion Y = Sheets("feuille de gestion").Range("AD9") Worksheets("Gestion").Range("I6") = Y W = Range("S65536").End(xlUp).Offset(0, 0) Worksheets("Gestion").Range("D5") = W Z = Sheets("PRimes").Range("D24") Worksheets("Gestion").Range("D27") = Z * 2 O = Range("R65536").End(xlUp).Offset(0, 0) M = Sheets("Gestion").Range("D7") N = Sheets("Gestion").Range("D9") P = Sheets("Gestion").Range("D19") Q = Sheets("Gestion").Range("D25") Worksheets("Gestion").Range("J35") = O + M + N + P + Q T = Range("J65536").End(xlUp).Offset(0, 0) U = Range("I65536").End(xlUp).Offset(0, 0) Worksheets("GS MO").Range("B4") = T / U V = Sheets("feuille de gestion").Range("AE4") Worksheets("Gestion").Range("L10") = V Worksheets("GS MO").Range("B7") = T 'Valeur théorique devis Dim FindString As String Dim Rng As Range FindString = "TOTAL PREVISIONS" 'InputBox("chercher mot") If Trim(FindString) <> "" Then With Sheets("feuille de Gestion").Range("A:A") Set Rng = .Find(What:=FindString, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then Application.Goto Rng, True Else MsgBox "Nothing found" End If End With End If i = ActiveCell.Column j = ActiveCell.Row d = ActiveCell.Column + 5 Value = ActiveCell.Offset(0, 9).Value Value2 = ActiveCell.Offset(0, 17).Value Worksheets("Gestion").Range("I33") = Value Worksheets("Gestion").Range("I35") = Value2 End Sub
Bonne journée
@Michel : Oui je pense qu'il y a bcp de chose a améliorer dans mon code, mais je suis assez fier de ma 1ere macro lol