Code VBA - SOS !!!

Fermé

Noemi - Modifié le 6 déc. 2020 à 15:33
yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 - 6 déc. 2020 à 19:50

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

A voir également:

Code VBA - SOS !!!
Code asci - Guide
Code puk bloqué - Guide
Code telephone oublié - Guide
Code blocks free - Télécharger - Langages
Code windows 10 - Guide

6 réponses

Réponse 1 / 6

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
Modifié le 6 déc. 2020 à 17:06

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à

yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
6 déc. 2020 à 19:50

bonjour,
pourquoi pas:

Set FL1 = Worksheets(i)

Réponse 2 / 6

Noemi
6 déc. 2020 à 17:34

ça ne fonctionne pas...

Set FL1 = Worksheets(Worksheets(i).Name)

erreur d'exécution '9'
L'indice n'appartient pas à la sélection

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
6 déc. 2020 à 18:04

La boucle se fait de la feuille 4 a la 15 vérifier si cela est possible

Réponse 3 / 6

Noemi
6 déc. 2020 à 18:17

 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 !! =) =)

Réponse 4 / 6

Noemi
6 déc. 2020 à 18:18

Merci merci merci !

ça me sauve la vie !!!

c'est génial je suis trop contente =) =) =)

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Noemi
6 déc. 2020 à 18:23

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

Réponse 6 / 6

Noemi
6 déc. 2020 à 18:37

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

Noemi
6 déc. 2020 à 18:43

J'ai juste modifié les numéros de page de 4 à 17 et ça fonctionne... bizarre

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728 > Noemi
6 déc. 2020 à 18:57

Content que cela fonctionne

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

Discussions similaires

Code de renvoi d'appel : Ooredo, Mobilis...

Acces à snapchat temporairement désactivé

Méthode find dans VBA - Recherche de données sous Excel

Code Free Wifi Secure : comment en récupérer

Discussions similaires

Newsletters