Discussion :

[Syl_22]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.