Macro : Collectés données plusieurs tableaux en UN

roidurif

XLDnaute Occasionnel
Bonjour,

Dans mon onglet "tableaux", je peux avoir plusieurs tableaux (des réfs, barême prix,...)

Je souhaite à partir d'une macro, récupérés chacune des données de cette onglet pour les intégrés dans chacune colonnes de l'onglet "cat".

J'ai fait quelques chose, cela fonctionne fonctionne pour la 1ere ref. et 1er prix, mais pas pour les autres.

J'ai mis un Exemple de resultat que je souhaite obtenir dans mon fichier.

Merci pour votre aide.

Code:
Sub tableau()

Dim R, D, D2, T, B, P As Range
dlng = Sheets("Tableaux").Range("B65536").End(xlUp).Row
'Application.ScreenUpdating = False

For i = 2 To dlng

'Do ' While to
'Références
Set R = Sheets("Tableaux").Cells.Find(What:="Référence :", LookIn:=xlValues, LookAt:=xlPart)
If Not R Is Nothing Then Sheets("cat").Range("C" & i) = R.Offset(, 1).Value

'Désignation
Set D = Sheets("Tableaux").Cells.Find(What:="DESIGNATION", LookIn:=xlValues, LookAt:=xlPart)
If Not D Is Nothing Then Sheets("cat").Range("D" & i) = D.Offset(, 1).Value

'Désignation
Set D2 = Sheets("Tableaux").Cells.Find(What:="DESIGNATION", LookIn:=xlValues, LookAt:=xlPart)
If Not D2 Is Nothing Then Sheets("cat").Range("E" & i) = D2.Offset(, 1).Value

'Unité
Set T = Sheets("Tableaux").Cells.Find(What:="UNITE", LookIn:=xlValues, LookAt:=xlPart)
If Not T Is Nothing Then Sheets("cat").Range("G" & i) = T.Offset(, 1).Value

'Bareme de prix
Set B = Sheets("Tableaux").Cells.Find(What:="Barème de prix :", LookIn:=xlValues, LookAt:=xlPart)
If Not B Is Nothing Then Sheets("cat").Range("F" & i) = B.Offset(, 1).Value

'Prix
Set P = Sheets("Tableaux").Cells.Find(What:="LE PRIX", LookIn:=xlValues, LookAt:=xlPart)
If Not P Is Nothing Then Sheets("cat").Range("H" & i) = P.Offset(, 1).Value

Next
    i = i + 1

'Loop


End Sub
 

Pièces jointes

  • Tableaux auto.zip
    15.3 KB · Affichages: 21
Dernière édition:

roidurif

XLDnaute Occasionnel
Re : Macro : Collectés données plusieurs tableaux en UN

Bonjour,

Je viens de refaire des modifications, mais rien à faire. Ce la ne chage rien, je n'arrive pas obtenir ce que je souhaite.

Je vous remercie infieniment pour votre aide.

Code:
Sub tableau()

Dim R, D, D2, T, B, P  As Range
Dim dlgn As Long

dlgn = Sheets("Tableaux").Range("B65536").End(xlUp).Row
'Application.ScreenUpdating = False

For i = 2 To dlgn

Do ' While to
'Références
Set R = Sheets("Tableaux").Cells.Find(What:="Référence :", LookIn:=xlValues, LookAt:=xlPart)
If Not R Is Nothing Then Sheets("cat").Range("C" & i) = R.Offset(, 1).Value

T = R.Cells.Address
'Désignation
Set D = Sheets("Tableaux").Cells.Find(What:="DESIGNATION", LookIn:=xlValues, LookAt:=xlPart)
If Not D Is Nothing Then Sheets("cat").Range("D" & i) = D.Offset(, 1).Value

'Désignation
Set D2 = Sheets("Tableaux").Cells.Find(What:="DESIGNATION", LookIn:=xlValues, LookAt:=xlPart)
If Not D2 Is Nothing Then Sheets("cat").Range("E" & i) = D2.Offset(, 1).Value

'Unité
Set T = Sheets("Tableaux").Cells.Find(What:="UNITE", LookIn:=xlValues, LookAt:=xlPart)
If Not T Is Nothing Then Sheets("cat").Range("G" & i) = T.Offset(, 1).Value

'Bareme de prix
Set B = Sheets("Tableaux").Cells.Find(What:="Barème de prix :", LookIn:=xlValues, LookAt:=xlPart)
If Not B Is Nothing Then Sheets("cat").Range("F" & i) = B.Offset(, 1).Value

'Prix
Set P = Sheets("Tableaux").Cells.Find(What:="LE PRIX", LookIn:=xlValues, LookAt:=xlPart)
If Not P Is Nothing Then Sheets("cat").Range("H" & i) = P.Offset(, 1).Value

Next
    i = i + 1

Loop


End Sub
 

Discussions similaires

Statistiques des forums

Discussions
299 951
Messages
1 980 336
Membres
207 060
dernier inscrit
Maggie2401