Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

un problème pour monsieur Irma !

cleopatatras

XLDnaute Nouveau
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
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…