Faire une boucle avec des numéros de lignes donnés par des variables obtenu

Bonjour à tous

Je ne suis pas très expérimenté mais je souhaiterai terminer une application me permettant de créer un devis à partir d'un métré (Feuille "Métrés").

Je récupère sur une feuille "Division" la localisation et les têtes de chapitre et je souhaiterai récupérer les natures d'ouvrages correspondant à chaque tête de chapitre sur une feuille "Ouvrage" dont la plage (Numéros de lignes) est donnée par des variables "x" & "y"

L'ensemble étant à copier sur la feuille "Devis"

J'arrive à traiter la première partie, (copie de la localisation et des chapitres),mais j ne sais pas comment aborder la deuxième (Copie des natures d'ouvrage de chaque tête de chapitre).

Ci après ma macro en cours d'élaboration

Vous en remerciant par avance.

Très cordialement.

SUB Rech_Division() Dim FL1 As Worksheet, FL2 As Worksheet, Cell As Range, NoCol As Integer, NoLig As Long Dim DerLig As Long, DerCol As Integer, Var As Variant Dim J As Long Dim x As Integer Dim y As Integer Dim i As Long Dim T As Long Dim Val As Variant Dim Unit As String Dim Cprix As String Set FL1 = Worksheets("Division") Set FL2 = Worksheets("Ouvrage") 'Détermine la dernière ligne renseignée de la feuille de calculs DerLig = Split(FL1.UsedRange.Address, "$")(4) 'Détermine la dernière colonne renseignée de la feuille de calculs DerCol = Columns(Split(FL1.UsedRange.Address, "$")(3)).Column With ActiveWorkbook.Worksheets("Division") J = 5 For NoCol = 10 To DerCol For NoLig = 1 To DerLig Var = FL1.Cells(NoLig, NoCol) If Var <> 0 Then 'Enregistrement et copie ligne de titre If NoLig = 1 Then Sheets("Division"). Range("D" & NoLig).Value = WorksheetFunction.VLookup(. Cells(NoLig, NoCol).Value, Sheets("Métrés").Range("B2:C13"), 2, False) Else Sheets("Division"). Range("D" & NoLig).Value = Range("D" & NoLig) End If 'Copie de la division sur la feuille devis T = NoCol + 2 ' Correspond aux numéro de colonne de la feuille "ouvrage" x = FL1. Range("H" & NoLig).Value ' Variable donnant la 1ère ligne de la plage ou se trouvent les natures d'ouvrages y = FL1. Range("I" & NoLig).Value ' Variable donnant la dernière ligne de la plage ou se trouvent les natures d'ouvrages FL1. Range("D" & NoLig).Copy Destination:=Sheets("Devis").Range("B" & j) Sheets("Devis").Cells(J, 7) = x Sheets("Devis").Cells(J, 8) = y Sheets("Devis").Cells(J, 9) = T J = J + 2 End If 'A partir d'ici, je souhaite aller sur la feuille "Ouvrage" et récupérer avec une boucle, les valeurs non nulles "Val" de chaque colonne "T" 'La désignation de la colonne "H" , "I", "J" 'situés dans la plage délimitée par x et y ' et les copier sur la feuille "Devis" ' Le numéro de colonne "T" de la feuille ouvrage sera T = NoCol + 2 Next NoLig Next NoCol Sheets("Devis").Activate MsgBox "L'enregistrement est terminé", vbInformation End With End Sub

Bonjour,

ça irait mieux avec un fichier excel

Bonjour

Je n'ai pas Excel, je travaille sur libre office.

Par ailleurs j'ai exploré une piste pour traiter mon problème.

La macro fonctionne mais ne donne pas le résultat escompté.

Ci après la nouvelle macro

SUB Devis() Dim i As Long Dim j As Long Dim DerniereLigne As Integer Dim Val As Variant Dim col As long Dim Unit As String Dim Cprix As String Dim Cellule As Range Dim Loc As Variant j = 5 'Application.ScreenUpdating = False Sheets("Ouvrage").Select With ActiveWorkbook.Worksheets("Ouvrage") 'calcul le nombre de lignes DerniereLigne = .Range("A1").End(xlDown).Row col = 12 For col = 12 to 22 i = 1 Do Val = Cells(i, col).Value Unit = Range("J" & i).Value Cprix = Range("I" & i).Value If Val <> 0 Then IF I = 1 Then . Range("H" & i).Value = WorksheetFunction.VLookup(. Cells(i, col).Value, Sheets("Métrés").Range("B2:C13"), 2, False) Val = 0 Unit = 0 Cprix = o Loc = Range("H" & i).Value 'Condition si pas de localisation If Loc = 0 Then Exit For End If Range("H" & i).Copy Destination:=Sheets("Devis").Range("B" & j) J = J + 2 Else [b] [Surligner]With ActiveWorkbook.Worksheets("Devis") Dim plage As Range Colonne = 2 Set plage = Range(Cells(5, Colonne), Cells(J, Colonne)) Dim c As Range For Each c In plage If c.Value <> Sheets("Ouvrage"). Range("D" & i).Value Then GoTo Line1 End If Next c[/b][/Surligner] [Surligner][b] Line1:[/b][/Surligner] Range("D" & i).Copy Destination:=Sheets("Devis").Range("B" & j) Sheets("Devis").Range("B" & j).Interior.Color = RGB(174, 240, 194) Sheets("Devis").Range("B" & j).Font.Name = "Courier" Sheets("Devis").Range("B" & j).Font.Size = 11 J = J + 2 [Surligner][b] Line2:[/b][/Surligner] Range("H" & i).Copy Destination:=Sheets("Devis").Range("B" & j) Sheets("Devis").Range("D" & j) = Val Sheets("Devis").Range("A" & j) = Cprix Sheets("Devis").Range("C" & j) = Unit j = j + 2 End With End If End If i = i + 1 Loop Until i = DerniereLigne Next COL End With sheets("Devis").Activate MsgBox "L'enregistrement est terminé", vbInformation End Sub

J'obtiens ça

Maçonneries et cloisons

04.09.03.110 Maçonnerie de brique creuse épais. 0,20 M2 187,5

04.09.08.125 Plus value pour chainage incorporé épaisseur 0.20 M2 75,00

Maçonneries et cloisons

04.09.08.155 Plus value pour linteaux épaisseur 0.20 M2 54,00

04.09.08.195 Plus value pour raidisseurs verticaux anti sismique épaisseur 0.20 M2 102,00

Je souhaite obtenir ceci

Maçonneries et cloisons

04.09.03.110 Maçonnerie de brique creuse épais. 0,20 M2 187,50

04.09.08.125 Plus value pour chainage incorporé épaisseur 0.20 M2 75,00

04.09.08.155 Plus value pour linteaux épaisseur 0.20 M2 54,00

04.09.08.195 Plus value pour raidisseurs verticaux anti sismique épaisseur 0.20 M2 102,00

Je continue à travailler de mon coté.

Cordialement

Bonjour,

VBA n'est pas très adapté pour une utilisation avec Libre Office, tu devrais utiliser LibreOffice Basic

Bonjour Patrice

Merci du conseil, je vais m'y atteler.

Cordialement

Rechercher des sujets similaires à "boucle numeros lignes donnes variables obtenu"