Extraire des données d'1colonne sur x lignes

[cleopatatras]

Bonjour le forum !
Pierre Yves 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

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Bonjour le forum...
et oups, je vais me faire décapiter !!...
Ce n'est pas Pierre Yves qui m'a aidée, mais bien PierreJean !...
Avec toutes mes excuses pour monsieur Irma !!

Cléo

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Bonjour le forum,

Personne ne peut me donner un coup de main??
S'il vous plait??
Par avance un grand merci et une bonne journée à vous!

Cléo

 

[pierrejean]

Re : Extraire des données d'1colonne sur x lignes

Bonjour Cleopatatras (tiens cela me rappelle un ami d'origine grecque)

Pour te faire pardonner peux-tu realiser un petit fichier exemple (sans données confidentielles )

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Bonjour le forum et bonjour PierreJean!

Quelle joie de retrouver monsieur Irma !!!

Voilà, j'ai fait un petit fichier qui, je l'espère sera plus clair !
En espérant que ce soit faisable.... j'avoue avoir retourner dans tous les sens mais il me manque l'explication du x=-1, que je ne comprends pas!

Encore merci de ton aide!

Cléo

 

[ChTi160]

Re : Extraire des données d'1colonne sur x lignes

Salut cleopatatras
Bonjour Le fil (mon Ami PierreJean en particulier)

En pièce jointe une première approche lol (j'ai gardé comme base la première procédure)
reste l'effacement de la plage à ajouter (voir si utile)

Le Fichier : Regarde la pièce jointe Price listV2.zip

PS : pour le x=-1 'rien de bien sorcier -1 c'est la valeur donnée au départ à la variable qui va servir a augmenter le nombre de colonne du tableau Variant TabRecup la numerotation des colonnes en Base 0 Et 0,1,2 etc etc donc en mettant x=x+1 j'obtiens 0 puis 1 etc etc pour quoi pas Zéro cela impose de mettre le x=x+1 en fin de boucle et moi j'aime pas lol
exemple pour
xx=-1

If TabRecup(It, L) <> "" Then 'si la condition est remplie
xx = xx + 1 'xx=-1+1 alors j'ajoute une colonne ou je vais coller les données
ReDim Preserve TabRecap(6, xx) 'au premier Tour j'aurais xx=0 etc etc
TabRecap(0, xx) = TabRecup(5, L)
TabRecap(1, xx) = TabRecup(4, L)
TabRecap(2, xx) = TabRecup(It, L)
TabRecap(3, xx) = TabRecup(9, L)
TabRecap(4, xx) = TabRecup(12, L)
TabRecap(5, xx) = TabRecup(11, L)

End If

on pourrait mettre
en initialisation xx=0
puis

If TabRecup(It, L) <> "" Then 'si la condition est remplie
ici xx sera égale à 0
ReDim Preserve TabRecap(6, xx) 'au premier Tour j'aurais xx=0
TabRecap(0, xx) = TabRecup(5, L)
TabRecap(1, xx) = TabRecup(4, L)
TabRecap(2, xx) = TabRecup(It, L)
TabRecap(3, xx) = TabRecup(9, L)
TabRecap(4, xx) = TabRecup(12, L)
TabRecap(5, xx) = TabRecup(11, L)
xx = xx + 1 'xx=0+1 alors j'ajoute une colonne ou je vais coller les prochaines données
End If

en espérant t'avoir éclairé lol

Bonne fin de journée

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Bonjour ChTi160,
Bonjour monsieur Irma,
Bonjour le fil,

Effectivement, avec tes explications, celà parait tellement évident! (Comme quoi on se creuse souvent les méninges sur des trucs simples !!).
En tout cas, un grand merci pour ton aide! C'est exactement ce que je cherchais!!
Je le teste, je l'adapte.... et je t'appelle à l'aide si je n'y arrive pas!

Grand merci et bonne journée

Cléo

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Re-bonjour ChTi160,
Re-bonjour le fil,

Ton fichier marche super et je l'ai adapté sans soucis à mon fichier!
J'aurais juste encore besoin d'un 'ChTi" coup de main
Quand on place le TabRecap sur la ligne 23 et suivantes, j'aimerais que les cellules en A et B soient recopiées sur le même nombre de ligne (Colonne "Repère" et "référence concernée).
Est ce que c'est possible??
Voici le fichier modifié ! et un grand merci pour ton aide!

 

[ChTi160]

Re : Extraire des données d'1colonne sur x lignes

SaLut Cléo

Bonsoir le fil
Bonsoir le Forum

Cela devrait être possible ,Mais je n'arrive pas à voir où tu vas pêcher le Numéro de la Colonne Repère
Dans la tente Lol
Bonne fin de Soirée

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Bonjour le fil, bonjour chti160,

Vous fréquenter me rend plus forte !!! j'ai trouvé comme une grande fifille comment faire pour recopier les lignes en même temps, j'ai juste introduit des lignes supplémentaires dans le TabRecap et le tour était joué!!
En tout cas merci: grâce à vous tous, je deviens plus douée en vba!!

Bonne journée,

Cléo

 

[ChTi160]

Re : Extraire des données d'1colonne sur x lignes

Salut Cléo
Bonjour le fil
Bonsoir le Forum

Ah content pour toi lOl
Moi , j'attends toujours la réponse à ma Question , mais bon , je ne saurais jamais !!!! LOL

Bonne fin de Soirée

 

[cleopatatras]

Re : Extraire des données d'1colonne sur x lignes

Salut ChTi160,
Bonjour le fil !!

Eh oui, on se croit maligne et on revient faire appel aux pro!!
Voilà mon nouveau problème:
j'ai un fichier"suivi" qui va chercher mes données dans un chouette fichier de ma composition (en fait une énorme bdd avec plusieurs onglets).
Dans mon module, j'ai mis une instruction de type :
worbooks.open"C:\monsuper fichier.xls"
... et ça marchait super,... jusqu'à ce que j'ai l'idée de mettre un usf sur "monsuperfichier".
Comme il est modal, lorsque je lance mon module de récupération de données dans mon fichier "suivi", le fichier"monsuperfichier" se bloque sur l'usf...... et ça ne marche plus.....
Je ne peux pas enlever l'usf (car d'autres utilisateurs en ont besoin), mais je ne sais pas comment le "neutraliser" lors de ma récupération de données....
Y'a t-il une formule magique me permettant de le neutraliser??? (de type "unload.accueil"??
J'ai essayé, mais ça ne marche pas... quelqu'un sait til comment neutraliser l'ouverture d'un USF ??

Merci pour votre aide!

Cléo