Macro Calcul selon formule

Bonjour à tous,

Je suis nouveau sur ce forum et je me permet de poster car je bloque. Je suis totalement débutant en code et je me suis embarqué dans quelque chose qui me dépasse pour aider ma compagne.

J'ai créé une macro qui permet de copier des colonnes selon une valeur d'une feuille à une autre avec un certain style.

Tout ça fonctionne très bien seulement j'aimerais qu'à la suite de ces valeurs copiées s'affiche les calculs selon différentes formules.

J'ai vaguement réussi à copier des cellules qui contiennent les résultats mais avec des problèmes de valeurs ou alors la copie se fait en 3 ou 4 fois bref.

Si quelqu’un a un bout de code pour que je puisse l'intégrer à ma Macro je lui en serais très reconnaissant...

Salut Dorian2a et

Pour commencer, il faut éviter les "select"

Exemple :

  Sheets("TABLEAU AUTOMATIQUE").Select
  Columns("A:F").Select
  Selection.Delete Shift:=xlToLeft

Peut ce coder

  Sheets("TABLEAU AUTOMATIQUE"). Columns("A:F").Delete Shift:=xlToLeft

Gain de temps

Re,

Sinon voici une possibilité de code

Sub MàJTableauAuto()
  Dim dLig As Long, LigD As Long, LigS As Long
  Dim ShtB As Worksheet
  ' Supprimer les cellules de la feuille de destination
  Sheets("TABLEAU AUTOMATIQUE").Columns("A:Z").Delete Shift:=xlToLeft
  ' Définir la feuille de base
  Set ShtB = Sheets("TABLEAU BASE")
  ' Dernière ligne de la feuille
  dLig = ShtB.Range("A" & Rows.Count).End(xlUp).Row
  ' Première ligne de destination
  LigD = 1
  For LigS = 1 To dLig
    With Sheets("TABLEAU AUTOMATIQUE")

      If ShtB.Range("B" & LigS) > "0" Then
        .Rows("1:30").RowHeight = 20

        .Range("A" & LigD) = ShtB.Range("A" & LigS)
        .Range("A" & LigD).Interior.Color = RGB(218, 238, 243)
        .Columns("A").ColumnWidth = 30

        .Range("B" & LigD) = ShtB.Range("B" & LigS)
        .Range("B" & LigD).Interior.Color = RGB(250, 191, 143)
        .Columns("B").ColumnWidth = 10

        .Range("C" & LigD) = ShtB.Range("C" & LigS)
        .Range("C" & LigD).Interior.Color = RGB(146, 208, 80)
        .Columns("C").ColumnWidth = 8

        .Range("D" & LigD) = ShtB.Range("D" & LigS)
        .Range("D" & LigD).Interior.Color = RGB(146, 208, 80)
        .Columns("D").ColumnWidth = 8

        .Range("E" & LigD) = ShtB.Range("E" & LigS)
        .Range("E" & LigD).Interior.Color = RGB(146, 208, 80)
        .Columns("E").ColumnWidth = 8

        .Range("F" & LigD) = ShtB.Range("F" & LigS)
        .Range("F" & LigD).Interior.Color = RGB(146, 208, 80)
        .Columns("F").ColumnWidth = 8

        With .Range("A" & LigD & ":F" & LigD)
          .Font.Name = "Calibri"
          .Font.Size = 10
          .Font.FontStyle = "Bold"
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .Borders(xlEdgeLeft).LineStyle = xlContinuous
          .Borders(xlEdgeTop).LineStyle = xlContinuous
          .Borders(xlEdgeRight).LineStyle = xlContinuous
          .Borders(xlEdgeBottom).LineStyle = xlContinuous
          .Borders(xlInsideVertical).LineStyle = xlContinuous
        End With
        ' Pour les formules
        ' Si il existe une quantité = numérique
        If IsNumeric(.Range("B" & LigD)) Then
          ' Un exemple
          ' Sachant que 1 g de glucides = 4 calories, 1 g de protéines = 4 calories et 1 g de lipides = 9 calories
          .Range("G" & LigD).FormulaLocal = "=C" & LigD & "*4+D" & LigD & "*9+E" & LigD & "*4"
        End If
        ' Incrémenter la ligne des destination
        LigD = LigD + 1
      End If
    End With
  Next LigS
End Sub

@+

Hello!

Merci beaucoup pour l'aide.

Malheureusement le code me met une erreur sur la ligne

.Range("G" & LigD).FormulaLocal = "=C" & LigD & "*4+D" & LigD & "*9+E" & LigD & "*4"""

Mes compétences étant trop limitées pour comprendre et corriger j'ai trouvé un palliatif en copiant à la main dans une autre feuille qui contient mes résultats.

Je reste ouvert si une solution se présente.

Re,

Je ne sais pas pourquoi ça bug, ca avait l'air de fonctionner chez moi, mais il s'agissait là d'un exemple

Cette ligne peut être supprimée

Sinon effectivement, il y a 2 guillemets en trop, code corrigé

@+

Top ca marche,

Merci beaucoup je vais me débrouiller avec ça.

Bonne soirée