Code VBA - SOS !!! Fermé

Question

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 :

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

cs_Le Pivert · Answer

Bonjour,

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à

Noemi · Answer

ça ne fonctionne pas... 

Set FL1 = Worksheets(Worksheets(i).Name)

erreur d'exécution '9'
L'indice n'appartient pas à la sélection

Noemi · Answer

Dim i As IntegerDim FL1 As Worksheet, NoCol As IntegerDim NoLig As Long, Var As Variant, cherche cherche = Worksheets("Saisies").Range("B2").Value    NoCol = 2 'lecture de la colonne BFor i = 4 To 15 'feuillesSet 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    NextNext

ce code là fonctionne !! =) =)

Noemi · Answer

Merci merci merci ! 

ça me sauve la vie !!! 

c'est génial je suis trop contente =) =) =)

Noemi · Answer

par contre quand je l'intègre à ma macro ça ne fonctionne plus ?
je ne l'ai pas mis au bon endroit ?


Sub RemplirTableauSaisie()'enlever la protection de la feuilleSheets("Saisies").SelectActiveSheet.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 IntegerDim FL1 As Worksheet, NoCol As IntegerDim NoLig As Long, Var As Variant, cherche cherche = Worksheets("Saisies").Range("B2").Value    NoCol = 2 'lecture de la colonne BFor i = 4 To 15 'feuillesSet 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    NextNext                                             '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

Noemi · Answer

en faite, ça ne marche pas que pour novembre et décembre... les autres mois ça fonctionne

Code VBA - SOS !!!

6 réponses

Discussions similaires