Modification/simplification de ce code VBA

[Greg]

Bonjour,

Le code ci dessous me permet de selectionner la zone de donnée que je souhaite celon un certain critere et de l'imprimer.

Probleme : je dois copier le meme code plusieurs fois pour remedier au fait qu'il peut y avoir plusieurs "zones" de donnée à imprimer celon le critere recherché.

Ma question est donc, comment modifier ce code, par exmple en l'integrant dans une boucle pour qu'il "sanne" toute la feuille excel et m'impirme les donnée que je souhaite.

Encore une autre question : comment interger une gestion des erreurs du style "si rien ne match avec le critere recherché afficher une message box et exit sub" ?

Voilà, j'espere avoir été +/- comprehensible lol

Merci d'avance pour votre aide,

Gregory

/////////////////////////////////////////

Sub Macro1()
'

' Critere de recherche. Par exemple dans ce cas toutes les cellules comme par exmple "342 gregory", "542 georges", etc.

variablefund = "42 g"

' selectionne le debut du fichier

Range("A1").Select

' Commence la recherche


Cells.Find(What:=variablefund, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

' definis le premier resultat trouvé comme variable pour ne pas qu il le reprenne une deuxieme fois en recommencqnt qu debut

StartCell = ActiveCell.Value

' Selectionne la zone de la cellule trouvée jusqu au mot Totals

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Cells.Find(What:="TOTALS", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True)).Select

' Imprime

Selection.PrintOut Copies:=1, Collate:=True


'***

Cells.Find(What:=variablefund, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

If ActiveCell.Value = StartCell Then
Exit Sub
End If

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Cells.Find(What:="TOTALS", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True)).Select
Selection.PrintOut Copies:=1, Collate:=True

'***


Cells.Find(What:=variablefund, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

If ActiveCell.Value = StartCell Then
Exit Sub
End If

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Cells.Find(What:="TOTALS", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True)).Select
Selection.PrintOut Copies:=1, Collate:=True


'***



Cells.Find(What:=variablefund, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

If ActiveCell.Value = StartCell Then
Exit Sub
End If

Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Cells.Find(What:="TOTALS", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True)).Select
Selection.PrintOut Copies:=1, Collate:=True


'***

 

[f.lauany]

Bonjour, ci joint un bout de code que j'ai mis au point dans un macro, et qui peut peut être te servir
Public Sub atrouver() 'RECHERCHE DE VALEURS IDENTIQUES, SANS ERREUR SI LA RECHERCHE EST INFRUCTUEUSE FLA 22-03-04
Feuil1.Activate 'ACTIVATION DE LA FEUILLE
Dim objCell As Range, PlageResult As Range, PremAdresse As String, atrouver As String
Dim Firstrow As Long, Firstcol As Long, Lastrow As Long, Lastcol As Long, Plage As Range
atrouver = "AXIOM" 'VALEUR À TROUVER
Firstrow = Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByRows).Row
Firstcol = Cells.Find(What:="*", SearchDirection:=xlNext, SearchOrder:=xlByColumns).Column
Lastrow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
Lastcol = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
Set Plage = Range(Cells(Firstrow, Firstcol), Cells(Lastrow, Lastcol))
Plage.Select 'ICI SELECTION OBLIGATOIRE SINON ERREUR'
With Plage

Set objCell = .Find(What:=atrouver, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not objCell Is Nothing Then
PremAdresse = objCell.Address
Do 'CREATION DE LA COLLECTION DES VALEURS CHERCHÉES
If PlageResult Is Nothing Then
Set PlageResult = objCell
Else
Set PlageResult = Application.Union(objCell, PlageResult) 'ici se crée la collection des valeurs cherchées
End If
Set objCell = .FindNext(objCell)
Loop While Not objCell Is Nothing And objCell.Address <> PremAdresse
End If
If Not PlageResult Is Nothing Then
PlageResult.Interior.ColorIndex = 7 ' MARQUE LES VALEURS A TROUVER
'MsgBox (PremAdresse)
With Range(PremAdresse) ' MARQUE LES VALEURS A TROUVER
.Interior.ColorIndex = 6
End With
End If
End With
End Sub

 

[Greg]

Salut,

MErci pour ta reponse. Malheureusement mes connaissances actuelles en VBA ne me permette pas de la comprendre tout à fait... :-(

Un grand merci quand même,
A+

Greg