Besoin d'aide sur une macro de "remplacement"

Chich0n · 2 Février 2011

Bonjour,

J'aurais besoin de votre aide pour pouvoir créer un macro de remplacement :
Les utilisateur saisissent un numéro (variable : Reponse)
Ce numéro (forcement un entier) est ensuite recherche dans toute colonne B.
C'est là qu'est mon problème :
J'aimerais que si la valeur Reponse est trouvée, excel remplace un groupe de cellule (par un copier/coller)
et que sinon il trouve la dernière ligne non utilisé, se décalle de quelques lignes et colle un groupe de cellule.
J'ai essayé ça :

Code:

Sub Macro1()
'
' Macro1 Macro
' diverse essais
'

   Dim Rame As String
  R = InputBox("Num")

Sheets(R).Select

  
  Dim Reponse As Integer
  Reponse = InputBox("Num de RED")
Sheets("Historique RED").Select

Range("B2").Select



    Dim Trouve As Boolean
    Dim x As Integer
    
    Trouve = False
    
    Do
        'Boucle tant que le compteur x est inférieur à 50
        Do While x < 400
            'Incrémente le compteur.
            x = x + 1
            'Vérifie le contenu de la cellule.
            If Cells(x, 2) = "Reponse" Then
                'Attribue la valeur Vrai si le mot est trouvé.
                Trouve = True
                'Anticipe la sortie de la boucle.
                Exit Do
            End If
        Loop
    'Quitte la boucle si la variable à la valeur True.
    Loop Until Trouve = True Or x = 1000
End
For Each Cell In Column(2)
If Trouve = True Then Range("A1").Select
    Cells.Find(What:=Reponse, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate
        ActiveCell.Offset(0, -1).Range("A1:AY8").Select
Selection.Delete Shift:=xlUp
Sheets(R).Select
Range("A1").Select
    Cells.Find(What:=Reponse, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate

        
    ActiveCell.Offset(-1, 0).Range("A1:AY10").Select
    Selection.Copy


If Trouve = False Then Range("A1").Select

End If
Range("A65536").End(xlUp).Offset(4, 0).Select
Sheets(R).Select
Range("A1").Select
    Cells.Find(What:=Reponse, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate

        
    ActiveCell.Offset(-1, 0).Range("A1:AY10").Select
    Selection.Copy
    ActiveSheet.Paste
    
Sheets(R).Select
Range("A1").Select

Je pense que je ne fais pas la bonne procédure ...

Chich0n · 2 Février 2011

Re : Besoin d'aide sur une macro de "remplacement"

Après quelques correction :

Code:

Sub Macro1()
'
' Macro1 Macro
' diverse essais
'

   Dim Rame As String
  R = InputBox("Num de rame")

Sheets(R).Select

  
  Dim Reponse As Integer
  Reponse = InputBox("Num de RED")
Sheets("Historique RED").Select

Range("B2").Select



    Dim Trouve As Boolean
    Dim x As Integer
    
    Trouve = False
    
    Do
        'Boucle tant que le compteur x est inférieur à 50
        Do While x < 400
            'Incrémente le compteur.
            x = x + 1
            'Vérifie le contenu de la cellule.
            If Cells(x, 2).Value = "Reponse" Then
                'Attribue la valeur Vrai si le mot est trouvé.
                Trouve = True
                'Anticipe la sortie de la boucle.
                Exit Do
            End If
        Loop
    'Quitte la boucle si la variable à la valeur True.
    Loop Until Trouve = True Or x = 1000
End
For Each Cell In Columns(2)
If Trouve = True Then Range("A1").Select
    Cells.Find(What:=Reponse, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate
        ActiveCell.Offset(0, -1).Range("A1:AY8").Select
Selection.Delete Shift:=xlUp
Sheets(R).Select
Range("A1").Select

 Next

If Trouve = False Then Range("A1").Select

End

Sheets(R).Select
Range("A1").Select
    Cells.Find(What:=Reponse, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate

        
    ActiveCell.Offset(-1, 0).Range("A1:AY10").Select
    Selection.Copy
    Sheets("Historique RED").Select
   Range("A65536").End(xlUp).Offset(4, 0).Select
   ActiveSheet.Paste
    
Sheets(R).Select
Range("A1").Select
        


End Sub

Besoin d'aide sur une macro de "remplacement"

Chich0n

XLDnaute Nouveau

Chich0n

XLDnaute Nouveau

Discussions similaires