Besoin d'aide sur code vba sur création boucle sur onglets avec conditions

Version imprimable

2 pièce(s) jointe(s)

Bonjour à tous,

Je débute sur vba. J'ai une problématique pour laquelle j'aurai besoin de votre aide. Je souhaite copier des cellules spécifiques à partir de certains onglets définis issu du fichier intitulé scénario pour les coller dans un onglet unique intitulé "Feuil1" du fichier "Descriptif paliers scénario".

Je voulais procéder par la création d'une boucle qui en fonction du nom de l'onglet issu du fichier scénario, copie certaines cellules et les collent dans le fichier "Descriptif scénario".

Ex : dans le fichier scénario ci-joint, les onglets "scenario", "suivi pt", "Evol 42h 80.6%" entre autre ne sont pas à prendre en compte. Par contre les autres onglets comme "42h MEO", "42h 80,6% Palier 1", "42h 80,6% Palier 2" sont à prendre en compte. Pour chacun de ces onglets, la macro doit copier les même cellules ("N34") et ("C24:H24") pour les coller dans le fichier "Descriptif paliers scénario" dans l'onglet "Feuil1" mais par contre sur des cellules définies mais qui sont différentes. Par ex : Pour l'onglet "42h MEO", la cellule "N34" doit être collée dans l'onglet "Feuil1" en cellule "B5" et la plage de cellule ("C24:H24") sont à coller transposer verticalement à partir de la cellule B8 de ce même onglet. Pour l'onglet "42h 80,6% Palier 1", la cellule "N34" doit être collée dans l'onglet "Feuil1" en cellule E5 et la plage de cellule ("C24:H24") sont à coller transposer verticalement à partir de la cellule E8 de ce même onglet.

Vous trouverez ci-dessous le code que j'ai commencé à rédiger mais qui est pour l'instant incomplet.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Sub Copier_collerv3()
 
Dim ListeFichier As Variant
Dim wk_source As Workbook
Dim wk_destination As Workbook
Dim onglet As Worksheet
 
Application.ScreenUpdating = False
 
Set wk_destination = ThisWorkbook
ListeFichier = Application.GetOpenFilename(Title:="Sélectionner votre classeur", filefilter:="Fichiers Excel (*.xls*),*xls*", ButtonText:="Cliquer")
If ListeFichier <> False Then
    Set wk_source = Application.Workbooks.Open(ListeFichier)
 
    'Boucle sur le nombre d'onglet
For i = 1 To wk_source.Worksheets.Count
 
    'identifier l'onglet
    Set onglet = wk_source.Worksheets(i)
 
        For Each onglet In ThisWorkbook.Worksheets
            If onglet.Name = "42h MEO" Then
                ActiveSheet.Range("N34").Copy
                wk_destination.Activate
                wk_destination.Sheets("Feuil1").Select
                Range("A5").Select
                ActiveSheet.Paste
                Range("A5:C5").Select
                    With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
                Selection.Merge
                Selection.ClearComments
                wk_source.Activate
                wk_source.Sheets(2).Select
                wk_source.Sheets(2).Range("C24:G24").Copy
                wk_destination.Activate
                wk_destination.Sheets(1).Select
                Range("B8").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=True
 
            ElseIf onglet.Name = "42h 80,6% Palier 1" Then
                ActiveSheet.Range("N34").Copy
                wk_destination.Activate
                wk_destination.Sheets("Feuil1").Select
                Range("E5").Select
                ActiveSheet.Paste
                Range("E5:G5").Select
                    With Selection
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = False
                    End With
                Selection.Merge
                Selection.ClearComments
                wk_source.Activate
                wk_source.Sheets(2).Select
                wk_source.Sheets(2).Range("C24:G24").Copy
                wk_destination.Activate
                wk_destination.Sheets(1).Select
                Range("F8").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=True
 
         ElseIf onglet.Name = "42h 80,6% Palier 2" Then
            ActiveSheet.Range("N34").Copy
            wk_destination.Activate
            wk_destination.Sheets("Feuil1").Select
            Range("I5").Select
            ActiveSheet.Paste
            Range("I5:K5").Select
                With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
                End With
            Selection.Merge
            Selection.ClearComments
            wk_source.Activate
            wk_source.Sheets(2).Select
            wk_source.Sheets(2).Range("C24:G24").Copy
            wk_destination.Activate
            wk_destination.Sheets(1).Select
            Range("J8").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=True
 
        End If
 
    Next
 
Next i
 
End If
 
wk_source.Close True
' wk_destination.Close True
 
 
Application.ScreenUpdating = True
 
End Sub

Merci d'avance pour votre aide.

Bonjour, voici une macro qui répond à ta demande.
Attention,dans ta demande tu veux copier les cellules C24:H24, c'est à dire de lundi à samedi mais dans ta Feuil1 la mise en forme est prévue pour recevoir lundi à vendredi, je te laisse faire les modifs nécessaires.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Copier_collerv3()
    Dim ListeFichier As Variant
    Dim wk_source As Workbook
    Dim wk_destination As Workbook
    Dim onglet As Worksheet
 
    Application.ScreenUpdating = False
 
    Set wk_destination = ThisWorkbook
 
    ' Sélection du fichier source
    ListeFichier = Application.GetOpenFilename(Title:="Sélectionner votre classeur", filefilter:="Fichiers Excel (*.xls*),*xls*", ButtonText:="Cliquer")
    If ListeFichier <> False Then
        Set wk_source = Application.Workbooks.Open(ListeFichier)
 
        ' Boucle sur le nombre d'onglets
        For Each onglet In wk_source.Worksheets
            Select Case onglet.Name
                Case "42h MEO"
                    onglet.Range("N34").Copy
                    With wk_destination.Sheets("Feuil1")
                        .Range("A5").Value = onglet.Range("N34").Value
                        .Range("A5").NumberFormat = onglet.Range("N34").NumberFormat
                        .Range("A5").HorizontalAlignment = xlCenter
 
                        .Range("B8:B13").Value = Application.Transpose(onglet.Range("C24:H24").Value)
                        .Range("B8:B13").NumberFormat = onglet.Range("C24:H24").NumberFormat
                        .Range("B8:B13").HorizontalAlignment = xlCenter
                    End With
 
                Case "42h 80,6% Palier 1"
                    onglet.Range("N34").Copy
                    With wk_destination.Sheets("Feuil1")
                        .Range("E5").Value = onglet.Range("N34").Value
                        .Range("E5").NumberFormat = onglet.Range("N34").NumberFormat
                        .Range("E5").HorizontalAlignment = xlCenter
 
                        .Range("F8:F13").Value = Application.Transpose(onglet.Range("C24:H24").Value)
                        .Range("F8:F13").NumberFormat = onglet.Range("C24:H24").NumberFormat
                        .Range("F8:F13").HorizontalAlignment = xlCenter
                    End With
 
                Case "42h 80,6% Palier 2"
                    onglet.Range("N34").Copy
                    With wk_destination.Sheets("Feuil1")
                        .Range("I5").Value = onglet.Range("N34").Value
                        .Range("I5").NumberFormat = onglet.Range("N34").NumberFormat
                        .Range("I5").HorizontalAlignment = xlCenter
 
                        .Range("J8:J13").Value = Application.Transpose(onglet.Range("C24:H24").Value)
                        .Range("J8:J13").NumberFormat = onglet.Range("C24:H24").NumberFormat
                        .Range("J8:J13").HorizontalAlignment = xlCenter
                    End With
            End Select
        Next onglet
    End If
 
    wk_source.Close False
    Application.ScreenUpdating = True
End Sub

10/07/2023, 17h17
Syl_22

Merci beaucoup, j'ai bien pris note de la modification à apporter. Le code fonctionne parfaitement.