Recherche d'une valeur de cellule dans le nom des feuilles
Résolu/Fermé
adamfred
Messages postés
11
Date d'inscription
lundi 10 juin 2013
Statut
Membre
Dernière intervention
4 juillet 2013
-
22 juin 2013 à 23:34
adamfred Messages postés 11 Date d'inscription lundi 10 juin 2013 Statut Membre Dernière intervention 4 juillet 2013 - 23 juin 2013 à 20:16
adamfred Messages postés 11 Date d'inscription lundi 10 juin 2013 Statut Membre Dernière intervention 4 juillet 2013 - 23 juin 2013 à 20:16
A voir également:
- Recherche d'une valeur de cellule dans le nom des feuilles
- Aller à la ligne dans une cellule excel - Guide
- Recherche automatique des chaînes ne fonctionne pas - Guide
- Nom de l'adresse - Forum Réseaux sociaux
- Consultez le code source de cette page. copiez la ligne qui indique aux moteurs de recherche de ne pas référencer la page. ✓ - Forum Référencement
- Vba récupérer valeur cellule ✓ - Forum VB / VBA
4 réponses
Patrice33740
Messages postés
8556
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
2 mars 2023
1 779
23 juin 2013 à 13:03
23 juin 2013 à 13:03
Bonjour,
Voici un exemple de code pour débutant :
Essaies de l'adapter à ton besoin, tu pourras ensuite poursuivre cette discussion en mettant ton fichier sur https://www.cjoint.com/
Tutoriel : Utiliser ci-joint
Voici un exemple de code pour débutant :
Option Explicit Option Private Module Public Sub adamfred() Dim wsh As Worksheet Dim rng As Range Dim cel As Range Dim txt As String 'Analyser chaque cellule de la plage A4:A21 For Each cel In ThisWorkbook.Worksheets("Recap Fr").Range("A4:A21").Cells 'Pour chaque feuille du classeur For Each wsh In ThisWorkbook.Worksheets 'Comparer la valeur de la cellule avec le nom de la feuille If cel.Value = wsh.Name Then 'si ça correspond, mettre en place les formules : '1° formule txt = "=""MaFormuleN°1""" wsh.Range("B4").FormulaLocal = txt '2° formule txt = "=GAUCHE(B4;11) & ""2""" wsh.Range("C4").FormulaLocal = txt 'Etc.. End If Next wsh Next cel End Sub
Essaies de l'adapter à ton besoin, tu pourras ensuite poursuivre cette discussion en mettant ton fichier sur https://www.cjoint.com/
Tutoriel : Utiliser ci-joint
adamfred
Messages postés
11
Date d'inscription
lundi 10 juin 2013
Statut
Membre
Dernière intervention
4 juillet 2013
2
23 juin 2013 à 19:28
23 juin 2013 à 19:28
Merci, Patrice33740
pour la reponse ,je m'y mets
pour la reponse ,je m'y mets
adamfred
Messages postés
11
Date d'inscription
lundi 10 juin 2013
Statut
Membre
Dernière intervention
4 juillet 2013
2
23 juin 2013 à 19:54
23 juin 2013 à 19:54
je viens de terminer une autre façon de faire sauf qu'il y'a un boucle infini.
Sub ParcoursdesRecap()
Dim myRangeRech, myRangeR As Range
Dim myLastRow, LastRowMp
Dim myLast As Variant
Dim i, j As Integer
Dim mySheet As Worksheets
Dim Nom As String
Dim mySheetRech As Range
Dim CellRech As Range
Dim MtPayé As Double
'DernLigne = Range("A" & Rows.Count).End(xlUp).Row
'DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Recap Fr").Select
myLastRow = Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
' nbre de ligne
myLastRow = myLastRow - 1
Set myRangeRech = Range("A4:A" & myLastRow)
For Each Cell In myRangeRech
Worksheets("Recap Fr").Select
For i = 4 To myLastRow
' la recherche des feuilles de calcul commence à la feuille(9)
For j = 9 To Worksheets.Count
Worksheets("Recap Fr").Select
Nom = Range("A" & i).Value
If Nom = Worksheets(j).Name Then
Worksheets(j).Select
Range("D4").Select
If Range("D4") = "" Then
LastRowMp = 0
Else
LastRowMp = Columns("D:D").Find("*", Range("D1"), , , xlByRows, xlPrevious).Row
'somme des colonnes
Worksheets("Recap Fr").Range("B" & i).FormulaR1C1 = Application.WorksheetFunction.Sum(Range("D4:D" & LastRowMp))
Worksheets("Recap Fr").Range("C" & i).FormulaR1C1 = Application.WorksheetFunction.Sum(Range("E4:E" & LastRowMp))
Worksheets("Recap Fr").Range("D" & i).FormulaR1C1 = Application.WorksheetFunction.Sum(Range("F4:F" & LastRowMp))
Worksheets("Recap Fr").Range("F" & i).FormulaR1C1 = LastRowMp - 3
End If
End If
Next j
Next i
Next
End Sub
Certes, il est chaotique mais il semble fonctionner, mais ta solution est plus limpide.
j'y joint le fichier
Merci
Sub ParcoursdesRecap()
Dim myRangeRech, myRangeR As Range
Dim myLastRow, LastRowMp
Dim myLast As Variant
Dim i, j As Integer
Dim mySheet As Worksheets
Dim Nom As String
Dim mySheetRech As Range
Dim CellRech As Range
Dim MtPayé As Double
'DernLigne = Range("A" & Rows.Count).End(xlUp).Row
'DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Recap Fr").Select
myLastRow = Columns("A:A").Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
' nbre de ligne
myLastRow = myLastRow - 1
Set myRangeRech = Range("A4:A" & myLastRow)
For Each Cell In myRangeRech
Worksheets("Recap Fr").Select
For i = 4 To myLastRow
' la recherche des feuilles de calcul commence à la feuille(9)
For j = 9 To Worksheets.Count
Worksheets("Recap Fr").Select
Nom = Range("A" & i).Value
If Nom = Worksheets(j).Name Then
Worksheets(j).Select
Range("D4").Select
If Range("D4") = "" Then
LastRowMp = 0
Else
LastRowMp = Columns("D:D").Find("*", Range("D1"), , , xlByRows, xlPrevious).Row
'somme des colonnes
Worksheets("Recap Fr").Range("B" & i).FormulaR1C1 = Application.WorksheetFunction.Sum(Range("D4:D" & LastRowMp))
Worksheets("Recap Fr").Range("C" & i).FormulaR1C1 = Application.WorksheetFunction.Sum(Range("E4:E" & LastRowMp))
Worksheets("Recap Fr").Range("D" & i).FormulaR1C1 = Application.WorksheetFunction.Sum(Range("F4:F" & LastRowMp))
Worksheets("Recap Fr").Range("F" & i).FormulaR1C1 = LastRowMp - 3
End If
End If
Next j
Next i
Next
End Sub
Certes, il est chaotique mais il semble fonctionner, mais ta solution est plus limpide.
j'y joint le fichier
Merci
adamfred
Messages postés
11
Date d'inscription
lundi 10 juin 2013
Statut
Membre
Dernière intervention
4 juillet 2013
2
23 juin 2013 à 20:16
23 juin 2013 à 20:16
Finalement ,j'ai vu pourquoi il y avait un boucle infini un "For Each Cell In myRangeRech" qui n'avait pas sa raison d'être.
" Je me nourri de mes échecs" ce qui permet d'apprendre toujours un peu plus
" Je me nourri de mes échecs" ce qui permet d'apprendre toujours un peu plus
23 juin 2013 à 13:04