Code VBA - SOS !!!
Noemi
-
yg_be Messages postés 24281 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 24281 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour à tous,
J'essaie de créer un code similaire à celui-là avec mes données adapter à mon fichier mais je n'y arrive pas...
SOS quelqu'un pourrait m'aider ????
Mes données :
Rechercher : la valeur de la cellule B2 (c'est une date) de la feuille "Saisies"
Dans : Feuille du classeur 4 à 15 ou Feuille de Janvier à Décembre aux cellules : B2 à B37
Ce que la macro devra faire si c'est une valeur trouvée :
Copie les cellules B2 à S2 de la feuille "Saisies"
Coller sur la cellule de la valeur trouvée dans la feuille trouvée
En dessous le code le plus rapprochant (enfin je ne suis pas certaine) mais pas avec mes données :
Merci d'avance pour tout !
Noemi
J'essaie de créer un code similaire à celui-là avec mes données adapter à mon fichier mais je n'y arrive pas...
SOS quelqu'un pourrait m'aider ????
Mes données :
Rechercher : la valeur de la cellule B2 (c'est une date) de la feuille "Saisies"
Dans : Feuille du classeur 4 à 15 ou Feuille de Janvier à Décembre aux cellules : B2 à B37
Ce que la macro devra faire si c'est une valeur trouvée :
Copie les cellules B2 à S2 de la feuille "Saisies"
Coller sur la cellule de la valeur trouvée dans la feuille trouvée
En dessous le code le plus rapprochant (enfin je ne suis pas certaine) mais pas avec mes données :
Sub Cherche()
'déclaration des variables :
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
'********* à adapter ***********
'affectation de valeurs aux variables :
'on cherche le mot "Trouve"
Valeur_Cherchee = "Trouve"
'dans la première colonne de la feuille active
Set PlageDeRecherche = ActiveSheet.Columns(1)
'*******************************
'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee,
LookAt:=xlWhole)
'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
'ici, traitement pour le cas où la valeur n'est pas trouvée
AdresseTrouvee = Valeur_Cherchee
& " n'est pas présent dans "
& PlageDeRecherche.Address
Else
'ici, traitement pour le cas où la valeur est trouvée
AdresseTrouvee = Trouve.Address
End If
MsgBox AdresseTrouvee
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub
Merci d'avance pour tout !
Noemi
A voir également:
- Code VBA - SOS !!!
- Code ascii - Guide
- Code puk bloqué - Guide
- Comment déverrouiller un téléphone quand on a oublié le code - Guide
- Code activation windows 10 - Guide
- Scanner qr code pc - Guide
6 réponses
Bonjour,
comme ceci:
voilà
comme ceci:
Option Explicit
Sub boucle()
Dim i As Integer
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant, cherche
cherche = Worksheets("Saisies").Range("B2").Value
NoCol = 2 'lecture de la colonne B
For i = 4 To 15 'feuilles
Set FL1 = Worksheets(Worksheets(i).Name)
For NoLig = 2 To 37 'colonne B
Var = FL1.Cells(NoLig, NoCol)
If Var = cherche Then
Worksheets("Saisies").Range("B2:S2").Copy _
Destination:=FL1.Cells(NoLig, 2)
End If
Next
Next
End Sub
voilà
ça ne fonctionne pas...
Set FL1 = Worksheets(Worksheets(i).Name)
erreur d'exécution '9'
L'indice n'appartient pas à la sélection
Set FL1 = Worksheets(Worksheets(i).Name)
erreur d'exécution '9'
L'indice n'appartient pas à la sélection
Dim i As Integer
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant, cherche
cherche = Worksheets("Saisies").Range("B2").Value
NoCol = 2 'lecture de la colonne B
For i = 4 To 15 'feuilles
Set FL1 = Worksheets(Worksheets(i).Name)
For NoLig = 2 To 37 'colonne B
Var = FL1.Cells(NoLig, NoCol)
If Var = cherche Then
Worksheets("Saisies").Range("B2:U2").Copy _
Destination:=FL1.Cells(NoLig, 2)
End If
Next
Next
ce code là fonctionne !! =) =)
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
par contre quand je l'intègre à ma macro ça ne fonctionne plus ?
je ne l'ai pas mis au bon endroit ?
je ne l'ai pas mis au bon endroit ?
Sub RemplirTableauSaisie()
'enlever la protection de la feuille
Sheets("Saisies").Select
ActiveSheet.Unprotect
'créer une nouvelle ligne
Range("A2").Select
Selection.ListObject.ListRows.Add (1)
'remplir le tableau saisie
Sheets("Formulaire").Select
Range("A78:U78").Select
Selection.Copy
Sheets("Saisies").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Dim i As Integer
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant, cherche
cherche = Worksheets("Saisies").Range("B2").Value
NoCol = 2 'lecture de la colonne B
For i = 4 To 15 'feuilles
Set FL1 = Worksheets(Worksheets(i).Name)
For NoLig = 2 To 37 'colonne B
Var = FL1.Cells(NoLig, NoCol)
If Var = cherche Then
Worksheets("Saisies").Range("B2:U2").Copy _
Destination:=FL1.Cells(NoLig, 2)
End If
Next
Next
'proteger feuille
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'revenir sur le formulaire
Sheets("Formulaire").Select
Range("A1").Select
'masquer les lignes
Rows("9:1000").Select
Selection.EntireRow.Hidden = True
'afficher les lignes des catégories
Rows("1:8").Select
Selection.EntireRow.Hidden = False
'explications
Range("A9:K11").Select
ActiveCell.FormulaR1C1 = ""
'affichage de la catégorie
Range("I1:L1").Select
ActiveCell.FormulaR1C1 = ""
Range("B12").Select
ActiveCell.FormulaR1C1 = "=R[4]C"
Range("D12").Select
ActiveCell.FormulaR1C1 = "=R[4]C"
Range("F12").Select
ActiveCell.FormulaR1C1 = "=R[4]C"
Range("H12").Select
ActiveCell.FormulaR1C1 = "=R[4]C"
Range("J12").Select
ActiveCell.FormulaR1C1 = "=R[4]C"
Range("L12").Select
ActiveCell.FormulaR1C1 = "=R[4]C"
Range("L16").Select
Range("A15:C15").ClearContents
Range("D15").ClearContents
Range("A18").ClearContents
Range("F21:I21").ClearContents
Range("A23:C23").ClearContents
Range("A25:C25").ClearContents
Range("A27:C27").ClearContents
Range("A29:C29").ClearContents
Range("A31:C31").ClearContents
Range("A33:C33").ClearContents
Range("A35:C35").ClearContents
Range("A37:C37").ClearContents
Range("A39:C39").ClearContents
Range("A41:C41").ClearContents
Range("A43:C43").ClearContents
Range("A45:C45").ClearContents
Range("A47:C47").ClearContents
Range("A49:C49").ClearContents
Range("A51:C51").ClearContents
Range("A53:C53").ClearContents
Range("A55:C55").ClearContents
Range("C57").ClearContents
Range("C57").ClearContents
Range("E59").ClearContents
Range("E62").ClearContents
Range("F57:I57").ClearContents
Range("A72:N72").ClearContents
' EffacerContenuTableau Macro
Rows("78:78").Select
Selection.ClearContents
End Sub
Content que cela fonctionne
Il faut mettre les déclarations de variables au début de la sub comme ceci:
Si cela convient marquer comme résolu au début de la demande
@+ Le Pivert
Il faut mettre les déclarations de variables au début de la sub comme ceci:
Sub RemplirTableauSaisie()
Dim i As Integer
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, Var As Variant, cherche
Si cela convient marquer comme résolu au début de la demande
@+ Le Pivert
pourquoi pas: