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

[roidurif]

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.

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

 

[Staple1600]

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

Bonjour

Une question en passant:
Tu déclares tes variables

et pourquoi tu ne déclares pas celle-ci : dlng 😕

 

[roidurif]

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

Bonjiour,

Simple oubli. Mais même avec cela, je n'arrive pas

Merci

 

[roidurif]

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.

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