[VBA-E] Récupération du nom d'un onglet et d'une valeur dans un autre fichier

Version imprimable

Bonjour,

J'ai un fichier contenant plusieurs onglets et je voudrais que pour chaque nom d'onglet on verifie s'il existe dans une colonne d'un autre fichier et dans ce cas on retoure la valeur associée.
Cette valeur devra être retourner sous la feuille portant le nom de l'onglet.

Pouvez vous m'aidez pour le code
je pense à quelque chose comme ça
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub Calcul_lambda onglet() Dim Feuille As Worksheet Application.ScreenUpdating = False For Each Feuille In ThisWorkbook.Worksheets Set CL2 = Workbooks("Recap-Calcul-Fides-" & NomCarte & ".xls") Set FL2 = CL2.Worksheets("Recap-Fides") Workbooks(CL2).Activate j = 8 Do While Feuille <> FL2.Range("A" & j).Value j = j + 1 Loop FL2.Range("E" & j).Select Windows("Calcul-lambda-Conn" &NomCarte).Activate Worksheets("Feuille").Range("L2").Value = FL2.Range("E" & j). Next Feuille Application.ScreenUpdating = True End Sub
Merci d'avance

11/05/2007, 12h52
tonton fred

Bonjour,

Tu as quoi comme erreur ? Ca ne te donne pas le bon resultat ou ca bloque completement ?

A vu de nez je pense que ca doit bloquer ici:

Code:

Do While Feuille <> FL2.Range("A" & j).Value

et ici

Code:

Windows("Calcul-lambda-Conn" &NomCarte).Activate

a remplacer (peut etre) par:

Code:

Do While Feuille.Name<> FL2.Range("A" & j).Value

et

Code:

Windows("Calcul-lambda-Conn" & NomCarte).Activate

Precise un peu plus ton probleme s'il te plait:)
11/05/2007, 17h14
alex.a

Mon code ne marche pas il ne se passe rien

pas d'erreur d'exécution

pouvez vous m'éclairer

merci

Pas d'erreur d'execution ? Si je copie ce que tu as ecrit j'ai des erreurs des la compilation ici

Code:

Sub Calcul_lambda onglet()

et ici

Code:

Worksheets("Feuille").Range("L2").Value = FL2.Range("E" & j).

Copie le code complet s'il te plait c'est plus facile

Sinon voila un code qui marche
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 Sub Calcul_lambda_onglet() Dim Feuille As Worksheet, FL2 As Worksheet Dim CL2 As Workbook Dim j As Integer Dim Existe As Boolean Application.ScreenUpdating = False Set FL2 = Workbooks("Book2").Worksheets("sheet1") For Each Feuille In ThisWorkbook.Worksheets j = 1 Do If Feuille.Name = FL2.Range("A" & j).Value Then Existe = True Exit Do Else j = j + 1 End If if j > 100 then exit do 'evite de boucler indefiniment si le nom n'apparait pas Loop If Existe Then 'ici tu fais ce que tu veux (copier le nom de l'onglet, de la ligne....) end if Existe = False Next Feuille Application.ScreenUpdating = True End Sub
Book2 contient des noms d'onglet dans la colonne A en partant de la ligne 1 dans Sheet1. A adapter a tes besoins ;)

Merci pour ton code tonton fred,

Je l'ai adapté mais j'ai toujours le même problème, c'est à dire rien dans la cellule voulu. J'ai rajouté la ligne Workbooks("Calcul-lambda-Res-" & NomCarte).Activate
avant For Each Feuille In ThisWorkbook.Worksheets sinon je vois pas comment dire que Feuille appartient à ce fichier. J'ai mis en gras les principales modifications de ton code.

Dans ton exemple Feuille est situé sur Book2?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 Public Sub Ajout_CalculFides(NomCarte As String, Version As String) Dim Feuille As Worksheet, FL2 As Worksheet Dim CL2 As Workbook Dim j As Integer Dim Existe As Boolean Application.ScreenUpdating = False Set FL2 = Workbooks("Recap-Calcul-Fides-" & NomCarte & ".xls").Worksheets("Recap-Fides") Workbooks("Calcul-lambda-Res-" & NomCarte).Activate For Each Feuille In ThisWorkbook.Worksheets nb_lignes_totales = FL2.UsedRange.Rows.Count j = 8 Do If Feuille.Name = FL2.Range("A" & j).Value Then Existe = True Exit Do Else j = j + 1 End If If j > nb_lignes_totales Then Exit Do 'evite de boucler indefiniment si le nom n'apparait pas Loop If Existe Then FL2.Range("E" & j).Select Workbooks("Calcul-lambda-Res-" & NomCarte & ".xls").Feuille.Range("L2").Value = FL2.Range("E" & j) End If Existe = False Next Feuille Application.ScreenUpdating = True End Sub

Feuille est defini ici:

Code:

For Each Feuille In ThisWorkbook.Worksheets

Donc il fait partie du workbook qui contient la macro (pas book2)

En lisant ton code un doute me vient: tu veux lire les noms des feuilles dans le Workbooks("Calcul-lambda-Res-" & NomCarte) et les comparer avec FL2.Range("A" & j).Value ?
Le plus simple serait que tu dises quel fichier lance la macro, quel fichier contient les feuilles et quel fichier contient la colonne avec les noms, je pense que le soucis est a ce niveau la.

EDIT:
Je pense que l'erreur en particulier est ici:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 Public Sub Ajout_CalculFides(NomCarte As String, Version As String) Dim Feuille As Worksheet, FL2 As Worksheet Dim CL2 As Workbook Dim j As Integer Dim Existe As Boolean Application.ScreenUpdating = False Set FL2 = Workbooks("Recap-Calcul-Fides-" & NomCarte & ".xls").Worksheets("Recap-Fides") For Each Feuille In WorkbookQuiContientLesFeuilles.Worksheets _ 'Workbooks("Calcul-lambda-Res-" & NomCarte) peut etre? thisworkbook _ est le classeur qui contient la macro meme si tu actives un classeur avant nb_lignes_totales = FL2.UsedRange.Rows.Count j = 8 Do If Feuille.Name = FL2.Range("A" & j).Value Then Existe = True Exit Do Else j = j + 1 End If If j > nb_lignes_totales Then Exit Do 'evite de boucler indefiniment si le nom n'apparait pas Loop If Existe Then FL2.Range("E" & j).Select Workbooks("Calcul-lambda-Res-" & NomCarte & ".xls").Feuille.Range("L2").Value = FL2.Range("E" & j) 'aussi, chez moi ajouter ".xls" met une erreur ici End If Existe = False Next Feuille Application.ScreenUpdating = True End Sub

14/05/2007, 17h15
alex.a

Citation:

Envoyé par tonton fred

Feuille est defini ici:

Code:

For Each Feuille In ThisWorkbook.Worksheets

Donc il fait partie du workbook qui contient la macro (pas book2)

Je n'ai pas de macro dans mes workbooks. J'ai défini mes macros dans des modules appellés depuis des UserForm

Pour essayer de préciser un peu
J'ai deux classeurs:
Recap-Calcul-Fides-" & NomCarte qui liste des composants et leurs tx de défaillance,(feuille "Recap-Fides") definie sous FL2
Et Calcul-lambda-Res qui donne le detail des composant de type Res (Résistance), sur ce classeur j'ai une feuille pour chaque composant. Le nom du composant étant le nom de la feuille

Je voudrais renseigner (sur le classeur Calcul-lambda-Res) la valeur du tx de défaillance (FL2) de chaque composant sur les différentes feuilles.
c'est à dire que si le nom de l'onglet est dans la liste (FL2) alors on renseigne la valeur associée (en "L2" de la feuille correspondante).

Citation:

Envoyé par tonton fred

tu veux lire les noms des feuilles dans le Workbooks("Calcul-lambda-Res-" & NomCarte) et les comparer avec FL2.Range("A" & j).Value ?

Oui c'est ce que j'essais de faire mais sans succès

fichier qui contient les feuilles : Calcul-lambda-Res-" & NomCarte
fichier qui contient la colonne avec les noms : Recap-Calcul-Fides-" & NomCarte

J'ai essayé mon code avec:

Code:

For Each Feuille In Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets

mais là j'ai une erreur d'exécution 1004, La méthode de la classe range à échoué.
Le fait de mettre ".xls" ne change apparemment rien, je l'ai retiré
15/05/2007, 11h20
tonton fred

Citation:

Envoyé par alex.a

Je n'ai pas de macro dans mes workbooks. J'ai défini mes macros dans des modules appellés depuis des UserForm

Oui, mais ce module est contenu dans un fichier, thisworkbook y fait reference.

Citation:

Envoyé par alex.a

J'ai essayé mon code avec:

Code:

For Each Feuille In Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets

mais là j'ai une erreur d'exécution 1004, La méthode de la classe range à échoué.

Alors ca c'est bizarre puisqu'il n'y a pas de range a cette ligne... Pourrais tu copier toute ta procedure ?

La ligne de code renvoyé est celle-ci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Public Sub Ajout_CalculFides(NomCarte As String, Version As String)

Dim Feuille As Worksheet, FL2 As Worksheet
Dim CL2 As Workbook
Dim j As Integer
Dim Existe As Boolean
Application.ScreenUpdating = False

Set FL2 = Workbooks("Recap-Calcul-Fides-" & NomCarte & ".xls").Worksheets("Recap-Fides")
'Workbooks("Calcul-lambda-Res-" & NomCarte).Activate
For Each Feuille In Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets

nb_lignes_totales = FL2.UsedRange.Rows.Count
j = 8
Do

If Feuille.Name = FL2.Range("A" & j).Value Then
Existe = True
Exit Do
Else
j = j + 1
End If

If j > nb_lignes_totales Then Exit Do 'evite de boucler indefiniment si le nom n'apparait pas

Loop

If Existe Then
          
    Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets(Feuille.Name).Range("L2").Select
    Workbooks("Calcul-lambda-Res-" & NomCarte).Feuille.Range("L2").Value = FL2.Range("E" & j).Value

End If

Existe = False
Next Feuille
Application.ScreenUpdating = True
End Sub

Feuille est deja defini comme faisant partie de la collection Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets a cette ligne

Code:

For Each Feuille In Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets

Donc ici

Code:

Workbooks("Calcul-lambda-Res-" & NomCarte).Feuille.Range("L2").Value = FL2.Range("E" & j).Value

il suffit d'ecrire

Code:

Feuille.Range("L2").Value = FL2.Range("E" & j).Value

.

Cette ligne ne sert a rien.

Code:

Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets(Feuille.Name).Range("L2").Select

La plupart du temps on peut se passer de activate et select.

Ce qui donne finalement:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Public Sub Ajout_CalculFides(NomCarte As String, Version As String) Dim Feuille As Worksheet, FL2 As Worksheet Dim CL2 As Workbook Dim j As Integer Dim Existe As Boolean Application.ScreenUpdating = False Set FL2 = Workbooks("Recap-Calcul-Fides-" & NomCarte & ".xls").Worksheets("Recap-Fides") For Each Feuille In Workbooks("Calcul-lambda-Res-" & NomCarte).Worksheets nb_lignes_totales = FL2.UsedRange.Rows.Count j = 8 Do If Feuille.Name = FL2.Range("A" & j).Value Then Existe = True Exit Do Else j = j + 1 End If If j > nb_lignes_totales Then Exit Do 'evite de boucler indefiniment si le nom n'apparait pas Loop If Existe Then Feuille.Range("L2").Value = FL2.Range("E" & j).Value End If Existe = False Next Feuille Application.ScreenUpdating = True End Sub

15/05/2007, 14h24
alex.a

Super ça marche !!!

Un grand merci à toi tonton fred :king: pour ton aide et tes conseils qui m'ont beaucoup appris.
encore merci.