XL 2013 boucle pour trouver et selectionner les cellules contenant un mot

LUCCHOBLANCHARD

XLDnaute Nouveau
Bonjour,
En colonne A j'ai une celulle qui contient REMETTANT CLIENT X.
Je voudrais trouver toutes les cellules contenant "REMETTANT", la selectionner en aggrandissant la selection de 18 lignes vers le bas et 2 colonne sur la droite > exemple pour client A, selectionner A1:C3 puis copier cette selection sur la feuille 2 en A1 de facon "transposé" > Horizontalement
Puis pour client B, selectionner A21:C39 et copier la selection à la suite du copier du client A (en A4) etc...
Il y a 617 clients à l'heure actuel.
J'espère avoir été clair.
Je vous mets le fichier en exemple.
Merci d'avance pour votre aide
 

Pièces jointes

  • Test Luccho Excel Downloads.xlsx
    15.8 KB · Affichages: 35

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour,

Essaie comme ça :

VB:
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OS (Onglet Destination)
Dim DL As Long'déclare la variable DL (Dernière Ligne)
Dim I As Long 'déclare la variable I (Incrément)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS
Set OD = Worksheets("Feuil2") 'définit l'onglet destination OD
DL = OS.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet OS
For I = 2 To DL Step 19 'boucle de 2 à DL par pas de 19
    TV = Cells(I, 1).Resize(19, 3) 'définit le tableau des valeurs TV
    'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A)
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, -1))
    DEST.Resize(3, 19).Value = Application.Transpose(TV) 'renvoie dans DEST redimensionnée le tableau TV transposé
Next I 'prochaine valeur de la boucle
OD.Columns("A:U").EntireColumn.AutoFit 'largeur des colonnes A à U automatique dans l'onglet OD
End Sub
 

Discussions similaires