Code VBA à adapter

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

Salut Noemi,

Sans fichier, difficile de faire mieux pour l'instant..

Public Sub Test()
'
Dim sWk As Worksheet, rCel As Range
'
Set sWk = Worksheets("Saisies")
If IsDate([B2]) Then
    On Error Resume Next
    With Sheets(3 + Month(CDate(sWk.[B2])))
        Set rCel = .Columns(2).Find(what:=sWk.[B2], lookat:=xlWhole, LookIn:=xlValues)
        If Not rCel Is Nothing Then
            .Range("B" & rCel.Row).Resize(1, 18).Value = sWk.[B2:S2].Value
        Else
            MsgBox "Cette date n'a pas été trouvée dans la feuille " & Sheets(3 + Month(CDate(sWk.[B2]))).Name, vbInformation + vbOKOnly, "Noemi"
        End If
    End With
    On Error GoTo 0
End If
'
End Sub


A+

Bonjour curulis,

ah ça ne fonctionne pas....

Je ne peux même pas mettre le fichier il est trop lourd ??? comment procéder alors ?

Salut Noemi,

Y a-t-il un message d'erreur et une ligne jaune dans le code ?

sur un autre forum j'ai eu un autre code qui fonctionne je le partage si quelqu'un en a besoin

Merci beaucoup beaucoup beaucoup Curulis de ton aide

 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
End Sub
Rechercher des sujets similaires à "code vba adapter"