Macro VBA boucle entre différente feuille

Le 12/02/2014 à 18:00

Bonjour

Et avant tout merci

Alors voila, mon problème :

J'ai deux colonnes de données par page, je souhaite :

1) Tracer un graphique par feuille (bonus pas nécessaire)

2) Récupérer dans une cellule le coef directeur de la droite

3) Exporter ce coef dans un tableau sur une feuille récapitulatif (donc une ligne par coef directeur donc par feuille).

je n'ai pas de problème pour obtenir le coef directeur par feuille (par contre le graph s'affichant est tjr celui de la feuille 1)

Par contre je n'arrive pas à remplir mon tableau sur ma feuille finale (MODULE-SECANT)

Je vous donne le code vba que j'ai réalisé, je souligne en disant que je suis archi débutant et que c'est la première fois que je code.

En vous remerciant

Sub Macro1()

' Macro1 Macro

Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = "MODULE-SECANT"

Range("A1").Select

ActiveCell.FormulaR1C1 = "Module sécant MPA"

Range("B1").Select

ActiveCell.FormulaR1C1 = "E / E0"

Range("C1").Select

ActiveCell.FormulaR1C1 = "D = 1 - E / E0"

End Sub

Sub Mac()

Dim MS As Worksheet, Ws As Worksheet

Set MS = Worksheets("MODULE-SECANT")

For Each Ws In ThisWorkbook.Worksheets

ActiveSheet.Shapes.AddChart.Select

ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

ActiveChart.SeriesCollection.NewSeries

ActiveChart.SeriesCollection(1).XValues = "='Feuil1'!$B$1:$B$17"

ActiveChart.SeriesCollection(1).Values = "='Feuil1'!$A$1:$A$17"

ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)

ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)

ActiveChart.SeriesCollection(1).Select

ActiveChart.SeriesCollection(1).Trendlines.Add

ActiveChart.SeriesCollection(1).Trendlines(1).Select

Selection.DisplayEquation = True

Selection.DisplayRSquared = True

Range("G1").Select

ActiveCell.FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"

MS.Cells(2, 1).Value = Sheets(1).Cells(1, 7).Value

MS.Cells(2, 2).Value = Sheets(1).Cells(1, 7).Value / 2

MS.Cells(2, 3).Value = 1 - MS.Cells(2, 2).Value

Next Ws

End Sub

Sub test()

Dim sh As Worksheet

Macro1

For Each sh In Sheets

sh.Select

Mac

Next sh

End Sub

10fichier-exemple-forum.xlsm (48.46 Ko)

Le 12/02/2014 à 18:08

Bonjour,

essaie ceci

Sub Mac()

Dim MS As Worksheet, Ws As Worksheet

Set MS = Worksheets("MODULE-SECANT")

    For Each Ws In ThisWorkbook.Worksheets

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=$B$1:$B$17"
ActiveChart.SeriesCollection(1).Values = "=$A$1:$A$17"
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Trendlines.Add
ActiveChart.SeriesCollection(1).Trendlines(1).Select
Selection.DisplayEquation = True
Selection.DisplayRSquared = True
Range("G1").Select
ActiveCell.FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"
MS.Cells(2, 1).Value = Sheets(1).Cells(1, 7).Value
MS.Cells(2, 2).Value = Sheets(1).Cells(1, 7).Value / 2
MS.Cells(2, 3).Value = 1 - MS.Cells(2, 2).Value
    Next Ws
End Sub

Le 13/02/2014 à 08:45

Salut

Merci, mais cela ne fonctionne pas ca me retourne une erreur.

En fait mon gros pb c'est d'aller recuperer la valeur de la cellule G1 sur chaque feuille et de venir les ranger dans mon tableau sur ma feuille Module-secant, avec un G1 par ligne en commencant à la ligne 2, le tout dans la colonne une.

Le 13/02/2014 à 10:06

Bonjour,

peux-tu tester ceci ?

Sub Mac()

Dim MS As Worksheet, Ws As Worksheet

l=1 : compteur de ligne sur MS  
Set MS = Worksheets("MODULE-SECANT")

    For Each Ws In ThisWorkbook.Worksheets
if ws.name <> ms.name then ' on ne prend pas en compte la feuille MODULE-SECANT
i=i+1
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=$B$1:$B$17"
ActiveChart.SeriesCollection(1).Values = "=$A$1:$A$17"
ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Trendlines.Add
ActiveChart.SeriesCollection(1).Trendlines(1).Select
Selection.DisplayEquation = True
Selection.DisplayRSquared = True
Range("G1").FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"
MS.Cells(i, 1).Value = Cells(1, 7).Value
MS.Cells(i, 2).Value = Cells(1, 7).Value / 2
MS.Cells(i, 3).Value = 1 - MS.Cells(i, 2).Value
end if
    Next Ws
End Sub

Le 13/02/2014 à 10:29

Salut

Le programme bug au niveau de la selection des données pour faire le graph.

ActiveChart.SeriesCollection(1).XValues = "=!$B$1:$B$17"

Mais ce n'est pas tres important comme je le disais le graph n'est pas le plus important.

C'est dans la partie final de la boucle que j'ai du mal

Range("G1").Select

ActiveCell.FormulaR1C1 = "=SLOPE(RC[-6]:R[16]C[-6],RC[-5]:R[16]C[-5])"

MS.Cells(2, 1).Value = Sheets(1).Cells(1, 7).Value

MS.Cells(2, 2).Value = MS.Cells(2, 1).Value / 2

MS.Cells(2, 3).Value = 1 - MS.Cells(2, 2).Value

Il faut que j'arrive a remplacer le "sheet(1)" par la feuille qu'il lit dans la boucle (si en bonus le code pouvait commencer de boucle de la feuille 2 a la derniere feuille en evitant de prendre en compte MS mais ca tu l'as deja fait.)

Encore merci

Le 13/02/2014 à 10:50

Voila un autre exemple pour comprendre la derniere partie du code importante

Il fonctionne correctement a ceux ci pret que la derniere valeur retenue dans ma colonne A est toujours la derniere valeurs en G1 de ma derniere feuille.

Je comprends le problème mais pour en sortir il faudrait arriver a croiser les boucles i et sh mais c'est impossible.

23teste-2.xlsm (21.00 Ko)

Le 13/02/2014 à 11:13

re-bonjour,

un nouvelle version, que je pensais déjà avoir envoyée.

Sub Mac()

    Dim MS As Worksheet, Ws As Worksheet

    i = 1:    'compteur de ligne sur MS
    Set MS = Worksheets("MODULE-SECANT")

    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> MS.Name Then    ' on ne prend pas en compte la feuille MODULE-SECANT
            i = i + 1
            Ws.Activate
            ActiveSheet.Shapes.AddChart.Select
            ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(1).XValues = "='" & Ws.Name & "'!$B$1:$B$17"
            ActiveChart.SeriesCollection(1).Values = "='" & Ws.Name & "'!$A$1:$A$17"
            ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
            ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
            ActiveChart.SeriesCollection(1).Select
            ActiveChart.SeriesCollection(1).Trendlines.Add
            ActiveChart.SeriesCollection(1).Trendlines(1).Select
            Selection.DisplayEquation = True
            Selection.DisplayRSquared = True
            Ws.Range("G1").FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"
            MS.Cells(i, 1).Value = Ws.Cells(1, 7).Value
            MS.Cells(i, 2).Value = Ws.Cells(1, 7).Value / 2
            MS.Cells(i, 3).Value = 1 - MS.Cells(i, 2).Value
        End If
    Next Ws
End Sub

Le 13/02/2014 à 11:15

Re-Salut

Alors il y a tjr les pb de graph, mais c'est pas hyper important, et j'ai reussis à avoir ce que je voulais pour la fin

voici le code

Sub Mac()

Macro1

Dim MS As Worksheet, sh As Worksheet

Set MS = Worksheets("MODULE-SECANT")

For Each sh In ThisWorkbook.Worksheets

If sh.Name <> MS.Name Then ' on ne prend pas en compte la feuille MODULE-SECANT

ActiveSheet.Shapes.AddChart.Select

ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

ActiveChart.SeriesCollection.NewSeries

ActiveChart.SeriesCollection(1).XValues = "='Feuil1'!$B$1:$B$17"

ActiveChart.SeriesCollection(1).Values = "='Feuil1'!$A$1:$A$17"

ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)

ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)

ActiveChart.SeriesCollection(1).Select

ActiveChart.SeriesCollection(1).Trendlines.Add

ActiveChart.SeriesCollection(1).Trendlines(1).Select

Selection.DisplayEquation = True

Selection.DisplayRSquared = True

sh.Select

Range("G1").Select

ActiveCell.FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"

With Sheets("MODULE-SECANT")

DerniereLigne = .Range("A65536").End(xlUp).Row + 1

End With

MS.Range("A" & DerniereLigne).Value = sh.Cells(1, 7).Value

MS.Range("B" & DerniereLigne) = MS.Range("A" & DerniereLigne).Value / 2

MS.Range("C" & DerniereLigne).Value = 1 - MS.Range("B" & DerniereLigne).Value

End If

Next sh

End Sub

Dans l'absolue si quelqu'un sait comment enlever la premiere feuille d'une boucle et regler le pb de graph =)

Merci

Le resultat est troublant :

Sur la feuille 1 j'ai le graph de la feuille 2

Sur la feuille 2 j'ai le graph de la feuille 2

Sur la feuille 3 j'ai pas de graph

Sur la feuille MODULE-SECANT j'ai le graph de la feuille 1

Le 13/02/2014 à 11:36

Merci
Le resultat est troublant :
Sur la feuille 1 j'ai le graph de la feuille 2
Sur la feuille 2 j'ai le graph de la feuille 2
Sur la feuille 3 j'ai pas de graph
Sur la feuille MODULE-SECANT j'ai le graph de la feuille 1

tu n'exécutes probablement pas le code que je t'ai fourni, peux-tu mettre ton code ?

Le 13/02/2014 à 13:15

Le voici

Sub Macro1()

' Macro1 Macro

Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = "MODULE-SECANT"

Range("A1").Select

ActiveCell.FormulaR1C1 = "Module sécant MPA"

Range("B1").Select

ActiveCell.FormulaR1C1 = "E / E0"

Range("C1").Select

ActiveCell.FormulaR1C1 = "D = 1 - E / E0"

End Sub

Sub Mac()

Macro1

Dim MS As Worksheet, sh As Worksheet

i = 1:

Set MS = Worksheets("MODULE-SECANT")

For Each sh In ThisWorkbook.Worksheets

If sh.Name <> MS.Name Then ' on ne prend pas en compte la feuille MODULE-SECANT

i = i + 1

ActiveSheet.Shapes.AddChart.Select

ActiveChart.ChartType = xlXYScatterSmoothNoMarkers

ActiveChart.SeriesCollection.NewSeries

ActiveChart.SeriesCollection(1).XValues = "='" & sh.Name & "'!$B$1:$B$17"

ActiveChart.SeriesCollection(1).Values = "='" & sh.Name & "'!$A$1:$A$17"

ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)

ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)

ActiveChart.SeriesCollection(1).Select

ActiveChart.SeriesCollection(1).Trendlines.Add

ActiveChart.SeriesCollection(1).Trendlines(1).Select

Selection.DisplayEquation = True

Selection.DisplayRSquared = True

sh.Select

Range("G1").Select

ActiveCell.FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"

With Sheets("MODULE-SECANT")

DerniereLigne = .Range("A65536").End(xlUp).Row + 1

End With

MS.Range("A" & DerniereLigne).Value = sh.Cells(1, 7).Value

MS.Range("B" & DerniereLigne) = MS.Range("A" & DerniereLigne).Value / 2

MS.Range("C" & DerniereLigne).Value = 1 - MS.Range("B" & DerniereLigne).Value

End If

Next sh

End Sub

Je ne vois pas ou il y a une erreur.

Le 13/02/2014 à 14:33

Sub Mac()

    Dim MS As Worksheet, Ws As Worksheet

   Set MS = Worksheets("MODULE-SECANT")
     i = ms.range("A" & rows.count).end(xlup).row

    For Each Ws In ThisWorkbook.Worksheets
        If Ws.Name <> MS.Name Then    ' on ne prend pas en compte la feuille MODULE-SECANT
           i = i + 1
            Ws.Activate 'tu as oublié cette ligne-ci
            ActiveSheet.Shapes.AddChart.Select
            ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
            ActiveChart.SeriesCollection.NewSeries
            ActiveChart.SeriesCollection(1).XValues = "='" & Ws.Name & "'!$B$1:$B$17"
            ActiveChart.SeriesCollection(1).Values = "='" & Ws.Name & "'!$A$1:$A$17"
            ActiveChart.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
            ActiveChart.SetElement (msoElementPrimaryValueAxisTitleRotated)
            ActiveChart.SeriesCollection(1).Select
            ActiveChart.SeriesCollection(1).Trendlines.Add
            ActiveChart.SeriesCollection(1).Trendlines(1).Select
            Selection.DisplayEquation = True
            Selection.DisplayRSquared = True
            Ws.Range("G1").FormulaR1C1 = "=SLOPE(RC[-6]:R[17]C[-6],RC[-5]:R[17]C[-5])"
            MS.Cells(i, 1).Value = Ws.Cells(1, 7).Value
            MS.Cells(i, 2).Value = Ws.Cells(1, 7).Value / 2
            MS.Cells(i, 3).Value = 1 - MS.Cells(i, 2).Value
        End If
    Next Ws
set ms=nothing
set ws=nothing
End Sub

Le 13/02/2014 à 14:40

Ah ZUT

Pardon

OKI MERCI

Je retente =)

Rechercher des sujets similaires à "macro vba boucle entre differente feuille"