un problème pour monsieur Irma !

[cleopatatras]

Eh oui, encore moi!
Monsieur Irma m'a déjà beaucoup aidé sur ce fichier, mais je dois encore faire appel au savoir faire des passionnés VBA !
Nous avions une recherche à partir d'une référence donnée.
Nous allions chercher dans une base de donnée, et on extrait la partie désirée.
Ce qui en vba donne ceci:

Sub Cherche1()
Dim DerCol As Byte
Dim Col As Byte

Dim DerLigne As Integer
Dim Ligne As Integer

Dim MaPlage As Range
Dim C As Range
Dim Ref As String

Dim Ws_Source As Worksheet
Dim Ws_Cible As Worksheet

Dim FirstAddress As String
Dim TabRecup() As Variant

Dim x As Integer

Workbooks.Open "P:\Commercial\Clients\***\Price list.xls", , True
Set Ws_Source = Worksheets("Price List")
Workbooks("Essai2.xls").Activate
Set Ws_Cible = Worksheets("Données")

With Ws_Cible
Ref = .Range("B3")

DerCol = .Range("IV7").End(xlToLeft).Column
If DerCol = 1 Then GoTo suite
With .Range(.Cells(5, 2), .Cells(19, DerCol))
.ClearContents
.Borders.LineStyle = xlNone
.Interior.ColorIndex = xlNone
End With
End With

suite:
If Ref = "" Then Exit Sub
x = -1
With Ws_Source

DerLigne = .Range("C100").End(xlUp).Row
DerCol = .Range("IV3").End(xlToLeft).Column
Set MaPlage = .Range(.Cells(2, 4), .Cells(DerLigne, 2 + DerCol))
Set C = MaPlage.Find(Ref, , , xlWhole)

If Not C Is Nothing Then 'si il existe au moins une occurrence

FirstAddress = C.Address
Do
Col = C.Column
x = x + 1
ReDim Preserve TabRecup(13, x)
For Ligne = 1 To 14
TabRecup(Ligne - 1, x) = .Cells(1 + Ligne, Col)
Next

Set C = MaPlage.FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
Else
Exit Sub
End If

End With
Application.ScreenUpdating = False
With Ws_Cible
With .Range("K3")
.Resize(UBound(TabRecup, 1) + 1, UBound(TabRecup, 2) + 1) = TabRecup
With .CurrentRegion
With .Borders

.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'mise en forme
.Rows("5:6").Interior.ColorIndex = .Rows("5").Range("A1").Interior.ColorIndex
.Rows("10:12").Interior.ColorIndex = .Rows("10").Range("A1").Interior.ColorIndex
.Rows("13").Interior.ColorIndex = .Rows("13").Range("A1").Interior.ColorIndex
End With
End With
End With
Application.ScreenUpdating = True
Workbooks("Price list.xls").Close SaveChanges:=False
End Sub

Le problème est que l'extraction se fait en colonne (1 colonne et 13 lignes).
Or, j'ai besoin d'extraire des données de cette colonne sur une même ligne... 🙁 Eh oui, ça se complique...)

A l 'heure actuelle , je récupère:
- ligne 1
- ligne 2
- ligne 3
- ligne 4 Etc...

Alors que j'aimerais récupérer :
- ligne 7 + ligne 6 + ligne 8 + ligne 11 + ligne 14
- ligne 7 + ligne 6 + ligne 9 + ligne 11 + ligne 14
- ligne 7 + ligne 6 + ligne 10 + ligne 11 + ligne 14

Je suppose qu'il faut modifier le TabRecup, mais je ne sais pas comment faire...

Pouvez-vous m'aider??
Merci d'avance
Cléo