1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
| Sub test1()
' Macro1 Macro
'
'
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1)), TrailingMinusNumbers:=True
ActiveWindow.SmallScroll Down:=-18
'déclaration des variables :
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String
'********* à adapter ***********
'affectation de valeurs aux variables :
'on cherche le mot "Trouve"
Valeur_Cherchee = "LABOR"
'dans la première colonne de la feuille active
Set PlageDeRecherche = Feuil1.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
MsgBox "C'est pas un rapport valide"
Else
'ici, traitement pour le cas où la valeur est trouvée
Range("A4:" & Trouve.Offset(-1, 0).Address).Select
Selection.Copy
Range("O4").Select
ActiveSheet.Paste
Range("D4:" & Trouve.Offset(-1, 4).Address).Select
Selection.Copy
Range("P4").Select
ActiveSheet.Paste
End If
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub |
Partager