Recopie de Feuilles avec code VBA

Version imprimable

Bonjour,
Je souhaite faire une recopie de feuilles avec le code VBA la feuille de référence est le mois de septembre qui comporte une macro pour faire une toupie automatique pour faire défiler des minutes ce code ne se recopie pas. Pourriez-vous m'aider ?
Merci .

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
Sub Copie_SEPT_AOUT()
'
' Copie_SEPT_AOUT Macro
'
'
    Application.Run "Déprotéger"
     Sheets("SEPT").Select
     Range("K1").Select
     ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,0)"
    Cells.Select
    Selection.Copy
 Dim ws As Worksheet
  For Each ws In Sheets(Array("OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AOÛT"))
ws.Activate
Cells.Select
ActiveSheet.Paste
ActiveWindow.ScrollRow = 1
Range("K1").Select ' la date se change dans cette cellule avec la formule ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,1)"
Next ws
 
 
    Sheets("OCT").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,1)"
    Range("K3").Select
 
 
    Sheets("NOV").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,2)"
    Range("K3").Select
 
 
    Sheets("DEC").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,3)"
    Range("K3").Select
 
 
    Sheets("JANV").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,4)"
    Range("K3").Select
 
    Sheets("FEV").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,5)"
    Range("K3").Select
 
    Sheets("MARS").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,6)"
    Range("K3").Select
 
 
    Sheets("AVRIL").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,7)"
    Range("K3").Select
 
 
    Sheets("MAI").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,8)"
    Range("K3").Select
 
 
    Sheets("JUIN").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,9)"
    Range("K3").Select
 
    Sheets("JUIL").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,10)"
    Range("K3").Select
 
 
    Sheets("AOÛT").Select
    ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,11)"
 
 
Dim Fs As Worksheet
  For Each Fs In Sheets(Array("OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AOÛT"))
Fs.Activate
Application.Run "impr"
ActiveWindow.ScrollRow = 1
Range("K3").Select
Next Fs
 
   Sheets("SEPT").Activate
   ActiveWindow.ScrollRow = 1
   Range("K3").Select
  Application.Run "Protéger"
End Sub

Si ca peut d'aider, le debut de ton code simplifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Copie_SEPT_AOUT()
 
    Dim ws As Worksheet
 
    Sheets("SEPT").Select
    Range("K1").FormulaR1C1 = "=EDATE(DATEDEB,0)"
    Range("K1").Copy
 
 
    For Each ws In Sheets(Array("OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AO?T"))
        ws.Activate
        Cells.Select
        ActiveSheet.Paste
        ActiveWindow.ScrollRow = 1
        Range("K1").Select ' la date se change dans cette cellule avec la formule ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,1)"
    Next ws
 
 
    '????? Sheets("OCT").FormulaR1C1 = "=EDATE(DATEDEB,1)"
    '...
 
End Sub

Peut-être

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Copie_SEPT_AOUT()
 
    Dim ws As Worksheet
 
    Sheets("SEPT").Select
    Range("K1").FormulaR1C1 = "=EDATE(DATEDEB,0)"
    Range("K1").Copy
 
 
    For Each ws In Sheets(Array("OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AO?T"))
        ws.Activate
        Range("K1").Select 
        ActiveSheet.Paste
        ActiveWindow.ScrollRow = 1
    Next ws
 
 
    '????? Sheets("OCT").FormulaR1C1 = "=EDATE(DATEDEB,1)"
    '...
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Copie_SEPT_AOUT()
 
    Dim ws As Worksheet
 
    For Each ws In Sheets(Array("SEPT","OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AO?T"))
 
        Range("K1").FormulaR1C1 = "=EDATE(DATEDEB,0)"
 
    Next ws
 
 
    '????? Sheets("OCT").FormulaR1C1 = "=EDATE(DATEDEB,1)"
    '...
 
End Sub

L'enregistreur de macro est juste pour aider, mais il faut revoir le code apres selon ce que l'on veut faire
et la, désolée, mais ca a peu de sens

Merci pour la simplification cependant elle ne fonctionne pas

Bonjour,

Merci pour ta réponse, cependant les feuilles ne se recopient pas toutes

uniquement le mois de septembre qui se copie dans octobre mais sans incrémenter Datedeb de 1 pour que ce soit le mois d'octobre.
J'ai fait un programme avec toupie pour faire défiler des heures dans les cellules, malheureusement je n'arrive pas à dupliquer ce code dans toutes les feuilles de OCT à AOÛT.
Peut-être as-tu une idée ?

Merci

Citation:

Envoyé par sogedic

Si ca peut d'aider, le debut de ton code simplifié

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Copie_SEPT_AOUT()
 
    Dim ws As Worksheet
 
    Sheets("SEPT").Select
    Range("K1").FormulaR1C1 = "=EDATE(DATEDEB,0)"
    Range("K1").Copy
 
 
    For Each ws In Sheets(Array("OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AO?T"))
        ws.Activate
        Cells.Select
        ActiveSheet.Paste
        ActiveWindow.ScrollRow = 1
        Range("K1").Select ' la date se change dans cette cellule avec la formule ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,1)"
    Next ws
 
 
    '????? Sheets("OCT").FormulaR1C1 = "=EDATE(DATEDEB,1)"
    '...
 
End Sub

Peut-être

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Copie_SEPT_AOUT()
 
    Dim ws As Worksheet
 
    Sheets("SEPT").Select
    Range("K1").FormulaR1C1 = "=EDATE(DATEDEB,0)"
    Range("K1").Copy
 
 
    For Each ws In Sheets(Array("OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AO?T"))
        ws.Activate
        Range("K1").Select 
        ActiveSheet.Paste
        ActiveWindow.ScrollRow = 1
    Next ws
 
 
    '????? Sheets("OCT").FormulaR1C1 = "=EDATE(DATEDEB,1)"
    '...
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Copie_SEPT_AOUT()
 
    Dim ws As Worksheet
 
    For Each ws In Sheets(Array("SEPT","OCT", "NOV", "DEC", "JANV", "FEV", "MARS", "AVRIL", "MAI", "JUIN", _
        "JUIL", "AO?T"))
 
        Range("K1").FormulaR1C1 = "=EDATE(DATEDEB,0)"
 
    Next ws
 
 
    '????? Sheets("OCT").FormulaR1C1 = "=EDATE(DATEDEB,1)" 
    '...
 
End Sub

L'enregistreur de macro est juste pour aider, mais il faut revoir le code apres selon ce que l'on veut faire
et la, désolée, mais ca a peu de sens

16/09/2018, 15h05
Philippe Tulliez

Bonjour,

Citation:

J'ai fait un programme avec toupie pour faire défiler des heures dans les cellules, malheureusement je n'arrive pas à dupliquer ce code dans toutes les feuilles de OCT à AOÛT.

Qu'entends-tu par là ?
16/09/2018, 15h10
sogedic
Code:

1 2 3 4 Sheets("OCT").Select ActiveCell.FormulaR1C1 = "=EDATE(DATEDEB,1)" Range("K3").Select
selectionne d'abord la cellule ou tu veux ecrire, ou ecrit directement dedans
Code:

1 2 3 Sheets("OCT").Select Range("K3").FormulaR1C1 = "=EDATE(DATEDEB,1)"
Pareil
Code:

1 2 3 ws.Activate Cells.Select ActiveSheet.Paste
tu dois déjà selectionner une cellule avant le paste

Honnêtement, il faut revoir ton code, ce n'est pas clair