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
| Option Explicit
Sub Recherche()
'Déclaration des variables
Dim oRng As Range
Dim i As Integer, n As Integer
Dim oProd As Range, oCell As Range
Dim oTable() As String
'Avec Feuil1 (feuille de données)
With Worksheets("Feuil1")
'On se place sur A1
Set oRng = .Range("A1")
'On parcours de A1 à la dernière ligne non-vide
For i = 0 To .Cells(.Rows.Count, 1).End(xlUp).Row - 1
'Si on trouve "tablette" ou "produits" (on peut enlever le LCase si souhaité)
If LCase(oRng.Offset(i, 0)) = "tablette" Or LCase(oRng.Offset(i, 0)) = "produits" Then
'On vérifie qu'on a des éléments à sa droite
If .Cells(oRng.Offset(i, 1).Row, .Columns.Count).End(xlToLeft).Column >= oRng.Offset(i, 1).Column Then
'Si oui, on récupère la range des valeurs
Set oProd = Range(oRng.Offset(i, 1), .Cells(oRng.Offset(i, 1).Row, .Columns.Count).End(xlToLeft))
'qu'on parcours.
For Each oCell In oProd
'Si on trouve quelque chose
If oCell <> "" Then
n = n + 1
'on sauvegarde les éléments.
ReDim Preserve oTable(1 To 2, 1 To n)
oTable(1, n) = oCell
oTable(2, n) = oCell.Offset(1, 0)
End If
Next oCell
End If
End If
Next i
End With
'Avec Feuil2 (feuille où l'on déplace les données)
With Worksheets("Feuil2")
'On se place après la dernière cellule non-vide de la colonne 1
Set oRng = .Cells(.Rows.Count, 1).End(xlUp)
'et on y écrit les résultats.
For i = LBound(oTable, 2) To UBound(oTable, 2)
oRng.Offset(i, 0) = oTable(1, i)
oRng.Offset(i, 1) = oTable(2, i)
Next i
End With
End Sub |
Partager