Boucle VBA Excel 2013

Bonjour,

Je suis nouveau sur VBA et j'ai comme mission au travail d'automatiser une feuille de calcul. J'ai donc fait l'enregistrement automatique en plaçant les commentaires qui vont bien.

Et depuis hier je tente de placer une boucle qui se déplace vers le bas pour répéter le processus jusqu'à rencontrer une ligne vide

Le but de mon travail est de copier les valeur dans les cellules GHI (Diamétre Ext, Inter et longueur) dans la feuille (Feuil1) et de faire calculer le devis

J'ai cherché sur divers forum dont le votre comment faire cela mais je n'arrive pas a intégrer la boucle comme je le souhaite.

Malheureusement pour des questions de confidentialité je ne peut pas vous joindre le fichier excel

Donc voilà je veux juste répéter en boucle cette opération de copier coller jusqu'a la première ligne vide

Merci

Sub TARIFTUBE()
'
' TARIFTUBE Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+W

'Début code pour copie des valeurs
Range("G2").Select.

Selection.Copy
Sheets("Feuil1").Select
Range("C2").Select
ActiveSheet.Paste

'Copy diamétre intérieur
Sheets("tube (BC08)").Select
Range("H2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil1").Select
Range("C3").Select
ActiveSheet.Paste

'Copy diamétre extérieur
Sheets("tube (BC08)").Select
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Feuil1").Select
Range("C4").Select
ActiveSheet.Paste 'Copy longueur
ActiveWindow.SmallScroll Down:=24
Range("C32").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tube (BC08)").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copy prix du tube
Sheets("Feuil1").Select
ActiveWindow.SmallScroll Down:=-30
Range("C2:C4").Select
Application.CutCopyMode = False
Selection.ClearContents

'Effacement des informations du devis (Diémtre inter, ext et longueur)
Sheets("tube (BC08)").Select
Range("J1").Select
'Fin du code pour la copie des valeurs
End Sub

Bonjour,

L'enregistreur de macro est un aide qui génère un code informatif qu'il faut entièrement réviser.

Pas sûr d'avoir compris ton problème, mais pour copier des valeurs, ça donnerait :

Option Explicit
Sub TARIFTUBE()
  With Worksheets("Feuil1")
    .Range("C2").Value = Worksheets("tube (BC08)").Range("G2").Value
    .Range("C3").Value = Worksheets("tube (BC08)").Range("H2").Value
    .Range("C4").Value = Worksheets("tube (BC08)").Range("I2").Value
    .Range("J2").Value = Worksheets("tube (BC08)").Range("C32").Value
  End With
End Sub

Oh d'accord, en faites l'enregistrement ne sert a rien, je dois revoir entièrement le code et mettre la boucle pour automatiser le tout ?

Je vais voir ce que je peux faire...

Bonjour,

Bon j'ai revu le code entièrement mais je n'arrive toujours pas a faire répéter l'opération.

L'idée c'est que la première partie, qui copie les donnée pour le calcul du devis puis ensuite copie le résultat vers la feuille tube, se répètent en se décalant d'une ligne vers le bas a chaque fois puis s'arrêtent une fois qu'il rencontre une ligne vide sur la feuille "tube"

Pour l'instant j'ai fait ce code et j'ai mit un exemple du fichier pour être plus clair

Sub
Dim i As Integer 'Pour la boucle

For i = 1 To 4800 'Nombre de répétition total

 With Worksheets("Devis")
    .Range("C2").Value = Worksheets("tube (BC08)").Range("G2").Value 'Copie diamétre intérieur "tube" vers "Devis"
    .Range("C3").Value = Worksheets("tube (BC08)").Range("H2").Value 'Copie diamétre exterieur "tube" vers "Devis"
    .Range("C4").Value = Worksheets("tube (BC08)").Range("I2").Value 'Copie longueur "tube" vers "Devis"
End With

With Worksheets("Tube")
    .Range("J2").Value = Worksheets("Devis").Range("C32").Value 'Copie  prix total "Devis" vers "Tube"
  End With

With Worksheets("Devis")
    .Range("C2:C4").Clear 'Effacement des données sur le devis
End With

ActiveCell.Offset(1, 0).Select 'Décalage d'une ligne vers le bas

Next i
End sub

Bonjour à tous,

Quel est objectif concrètement car on ne comprend pas bien ?

Voici un essai basé sur une intuition où :

- on détermine la dernière ligne de tube ;

- on alimente un tableau en mémoire par le produit, pour chacune des lignes allant de 2 à cette dernière ligne, des cellules en G à I ;

- on restitue toutes ces données d'un coup en colonne J (à partir de la ligne 2) retaillée au nombre d'items du tableau :

Sub boucletest()

With Worksheets("Tube")
    dl = .cells(.rows.count, "G").end(xlup).row 'dernière ligne en colonne G de feuille tube
    redim t(1 to dl - 1, 1 to 1) 'tableau accueillant données
    For i = 2 To dl
        t(i, 1) = application.product(.range("G:I").rows(i)) 'MODIFIER PAR CALCUL PERMETTANT D'OBTENIR C32 DEVIS A COLLER EN Ji DE TUBE
    next i
    .range("J2").resize(ubound(t), 1) = t
end with

End sub

Si mon intuition était bonne, il faudrait savoir qu'une simple formule aurait pu suffire...

Cdlt,

Si mon intuition était bonne, il faudrait savoir qu'une simple formule aurait pu suffire...

En faite non; dans la partie devis, il y a toute une partie du calcul (Avec des formules indépendantes) que j'ai supprimé pour confidentialité, donc une simple formule excel n'aurai pas suffit

Mon but est d'automatiser le calcul du devis et chaque fois qu'un nouveau produit est rentré ou modifié dans la feuille "Tube", j'utilise la macro pour calculer automatiquement la valeur finale du produit à l'aide de la feuille "Devis"

Et mon problème est le suivant : Ajouter une boucle à mon code qui calcul automatiquement tout les tubes et s'arrête à la première ligne vide rencontré

Là j'essaie d'adapter ton code pour automatiser le tout, je verrai bien au final

Bonjour,

En fait, comme vous passez par VBA, l'idéal est de réaliser les calculs en mémoire et de ne pas passer par Excel (car ça prend beaucoup de temps, surtout si vous avez 4800 itérations !).

Donc il faudrait connaitre les étapes de calcul pour les réaliser dans le code car le fait de transiter par la feuille DEVIS n'est pas du tout nécessaire à mon avis...

Comme je vois qu'il s'agit de longueur et de diamètre, je me dis qu'il faut donc calculer un volume, qui permettrait d'obtenir un prix à partir d'un coefficient dont l'unité serait prix/L par exemple. Si c'est bien ça, ce n'est pas compliqué de le faire dans le code, on peut même définir une fonction personnalisée. Et ce serait tout à fait possible de le faire uniquement par formule.

Mais bon, ce sont des suppositions que j'émets sans avoir connaissance du fichier...

Cdlt,

A la limite je peut te donner les formules excel sans les intitulés

Bonjour,

Comme c'est un peu le foutoir votre onglet DEVIS, je reviens sur mon idée de départ (que je n'écarte pas totalement non plus) et propose ce code :

Sub boucletest()
application.screenupdating = false
With Worksheets("Tube")
    dl = .cells(.rows.count, "G").end(xlup).row 'dernière ligne en colonne G de feuille tube
    For i = 2 To dl
        sheets("Devis").Range("C2:C4").Value = application.transpose(.Range("G:I").rows(i).Value)
        .Range("J" & i).Value = Worksheets("Devis").Range("C32").Value
    next i
end with
sheets("Devis").Range("C2:C4").value = ""
application.screenupdating = true
End sub

De cette manière, on effectue l'opération en bouclant : on copie les diamètres et la longueur de chaque ligne de TUBE en C2:C4 de DEVIS puis on copie C32 de DEVIS sur la ligne en cours de TUBE.

Il est possible que ça prenne du temps quand même avec un grand nombre de lignes...

Cdlt,

Bonjour,

Merci pour la solution, effectivement cela marche même si celle ci est bien plus complexe que ce j'imaginais à la base

Bonne Journée