Discussion :

[altra]

Bonjour le forum,

Je souhaiterais pouvoir archiver une feuille d'un classeur A dans un classeur B.
Pour l'instant grâce à une macro j'arrive à créer ce classeur s'il n'existe pas et à copier ma feuille dans celui-ci. Si ce classeur existe déja je veux copier certaine cellules que je colle à un certain endroit en fonction d'un mot dans une cellule de la feuille à archiver/
Ainsi a chaque fois que l'on appuie sur le bouton qui active la macro, la feuille d'archive se remplira de la gauche vers la droite.

Mais lors de l'execution j'ai une msgbox qui apparait et me dit "ERREUR 9 : l'indice n'appartient pas à la sélection". Il semblerait que la macro n'arrive pas à trouver ma feuille, mais je ne sais pas quoi rajouter, c'est pour cela que je viens solliciter votre aide.

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
Private Sub Archiver_Click()
Dim année As Integer
Dim mois As String
Dim archivage As String
Dim i As Integer
 
année = Year(Now())
mois = Format(Now(), "mmm")
archivage = "Archives" & année & ".xls"
 
fichier = Dir("C:\Documents and Settings\Desktop\Rapport\" & archivage)
 
If fichier = "" Then
 
    Sheets("Rapport de Quart").Copy
    Sheets("Rapport de Quart").Name = mois
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Desktop\Rapport\" & archivage, _
        FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    With Sheets(mois)
        .Shapes("CommandButton1").Delete
        .Shapes("CommandButton2").Delete
        .Shapes("Archiver").Delete
    End With
 
 
Else
 
    If Range("C1") = "Matin" Then
        i = Day(Now) - 1
 
            Sheets("Rapport de Quart").Range("rapport").Copy
        Windows("Archives" & année & ".xls").Activate
        Sheets(mois).Range(Cells(1, 2 + 6 * i)).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False
Else
 
    If Range("C1") = "Soir" Then
        i = Day(Now) - 1
 
            Sheets("Rapport de Quart").Range("rapport").Copy
        Windows("Archives" & année & ".xls").Activate
        Sheets(mois).Range(Cells(1, 4 + 6 * i)).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False
 
Else
 
    If Range("C1").Text = "Nuit" Then
        i = Day(Now) - 1
 
            Sheets("Rapport de Quart").Range("rapport").Copy
        Windows("Archives" & année & ".xls").Activate
        Sheets(mois).Range(Cells(1, 6 + 6 * i)).Select
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Application.CutCopyMode = False
 
    End If
    End If
    End If
 
End If
 
End Sub

La macro stoppe à cette ligne

Code :

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

       Sheets(mois).Range(Cells(1, 2 + 6 * i)).Select

Je suis sur que l'on peut simplifier mon code, que j'ai en partie faire grâce à l'enregistreur, donc ne vous gênez pas.



Merci

[mercatog]

Ton code est presque illisible avec tes if et else
refais avec les select case et pour la lisibilité essayes de revoir l'indentation

Si je comprends bien, si la classeur archive n'existe pas, il sauvegarde le classeur courant sous un autre nom, avec changement de nom de la feuille "Rapport de Quart"
à quoi sert cette ligne: (en gras)

Code :

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

1
2
3
4
If fichier = "" Then
        
    Sheets("Rapport de Quart").Copy
    Sheets("Rapport de Quart").Name = mois

Si le calsseur existe déja, tu es sûr que la feuille Sheets(mois)existe?

pour la copie tu peux essayer: Wbs.Shs.range(X).copy Destination:=Wbd.Shd.Range(Y)
Wbs workbook source
Shs: Sheet source
Wbd workbook destination
Shd: Sheet source

sans les Select et les activate!

Travaille un peu ton code

EDIT: C'est quoi cela?

Code :

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

Range(Cells(1, 2 + 6 * i)).Select

Pour la zone où copier, tu peux mettre comme ci:

Code :

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

1
2
3
4
5
6
7
8
9
 
Dim Col as integer
.....
 
Select case UCase(Trim(Range("C1").value))
     Case "MATIN" : Col=6*Day(Now)-4
     Case "SOIR" : Col=6*Day(Now)-2
     Case "NUIT": Col=6*Day(Now)
End Select

Tu récupère ainsi la colonne ou se fera la copie de tes données

Attention au classeur actif!

[altra]

Re et merci pour ton post.

Tout d'abord, j'ai résolu mon problème en modifiant effectivement ceci

Code :

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

       Sheets(mois).Range(Cells(1, 2 + 6 * i)).Select

par ceci

Code :

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

       Sheets(mois).Cells(1, 2 + 6 * i).Select

donc l'archivage fonctionne.


Ensuite, pour répondre à tes questions :
bonne remarque pour les select case, je vais faire ça.

Je vais essayer de mieux reexpliquer.

Donc si le classeur archive n'existe pas, il copie le feuille Rapport de Quart dans un autre classeur qu'il crée(je pense que c'est effectué grâce à la ligne en gras) puis il renomme la feuille en 'mois' et ensuite il enregistre ce classeur sous le Nom Archives2009 (pour cette année).

Si le classeur existe déjà, la feuille 'mois' existe bien parce qu'elle a été créee par la condition d'avant.

Je vais essayer ton code pour gérer la copie.

Je ne comprends pas ça

Code :

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

Select case UCase(Trim(Range("C1").value))

en particulier UCase et Trim pourquoi doit on passer en majuscules et supprimer les espaces.

De plus avec tes calculs on peut se retrouver avec des valeurs négatives si on est en début de mois.


J'aimerais aussi un peu améliorer l'archivage.
Si c'est possible, je voudrais que tout cet archivage se fasse masqué. C'est à dire sans que le classeur d'archive s'ouvre ou ne soit visible.

Merci pour ton aide, je retourne modifier le code

[mercatog]

Pour être sur que matin et Matin et maTin avec des espaces avant ou après sera compris comme un seul mot! Tu peux les enlever si tu es sûr que "Matin" s'écrira toujours "Matin"

valeurs négatives? mais où?

si l'archive du mois n'existe pas tu renomme ta feuille
tu save as ton classeur et tu supprime tes boutons

Code :

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

1
2
3
If fichier = "" Then
 
    Sheets("Rapport de Quart").Copy

tu copies Rapport de Quart vers quel emplacement avec cette ligne???
mets là en commentaire et reporte le changement

avec un

Code :

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

Application.ScreenUpdating = False

au début du code
et un

Code :

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

Application.ScreenUpdating = True

à la fin, l'ecran reste figé jusqu'à la fin

[altra]

Ok pour le coup des valeurs négatives je suis un boulet .

Ce code vient du générateur de macro

Code :

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

1
2
3
If fichier = "" Then
 
    Sheets("Rapport de Quart").Copy

Donc je ne sais pas comment fonctionne cette ligne mais il copie ma feuille vers un nouveua classeur.
Les evenements se font dans cet ordre.

1. La feuille est copiée dans un nouveau classeur, sans emplacement, sans rien. Excel le nomme Classeur 2 par exemple
2. La feuille, dans ce nouveau classeur est renommé par le mois en cours et on lui enlève les boutons que je ne veux pas dans les archives
3. Le nouveau classeur est enregistré dans un dossier destination en tant que Archives'année en cours'

[mercatog]

Voyons le problème dès le début;
Tu as un classeur de travail A
dans la feuille "Rapport de Quart" de ce classeur tu as des boutons dont archiver
Si aujourd'hui tu clique sur ce bouton, il cherche le classeur archive B de 2009.
si B n'existe pas, il crée ce classeur et copie la feuille "Rapport de Quart" dans ce classeur en la nommant "8".
si B existe, il copie les données de "Rapport de Quart" vers la feuille "8" du classeur B.
déjà certaines remarques:

Si le classeur existe déjà, la feuille 'mois' existe bien parce qu'elle a été créee par la condition d'avant.

Le classeur B est unique par année
dans ce classeur tu es sûr que le mois 10 existe si tu veux archiver les données d'Octobre??? (archive2009 existe mais où la feuille 10)

Evite de nommer les feuilles en nombres

Code :

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

Sheets(mois).Cells(1, 2 + 6 * i).Select

si mois=6, Sheets(6) !6 étant l'index de la feuille et non le nom
essaie par exemple de mettre

Code :

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

Sheets("Rapport de Quart").name="m"&mois

Certaines choses à revoir si j'ai bien compris

Mea culpa, tes feuilles sont sous form mmm jan fev ....
je retire la remarque concernant ce point

Regardes cette proposition:
dans la feuille "Rapport de Quart", j'ai mis un bouton nommé btnArch qui permet d'archiver les données dans un autre classeur
Certaines adaptations et améliorations à faire:

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
Option Explicit
Private Sub btnArch_Click()
 
Dim annee As Integer, i As Integer, col As Integer
Dim stMois As String, stFichier As String, stFichierComp As String, stExistFich As String
Dim wbk As Workbook, arwbk As Workbook
Dim shrq As Worksheet, shm As Worksheet, ws As Worksheet
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Set wbk = ActiveWorkbook
Set shrq = ActiveSheet
 
annee = Year(Date)
stMois = CStr(Format(Date, "mmm"))
 
stFichier = "Archives" & annee & ".xls"                             'Nom Fichier archives
stFichierComp = "C:\Users\user\Desktop\Rapports\" & stFichier       'Nom complet (à adapter)!!!!!!!!!!!!!!!!!!!!!!!
 
Select Case UCase(Trim(Range("C1").Value))                          'recupère la colonne où les données seront copiées!! Les colonnes?
    Case "MATIN": col = 6 * Day(Date) - 4
    Case "SOIR": col = 6 * Day(Date) - 2
    Case "NUIT": col = 6 * Day(Date)
End Select
 
stExistFich = Dir(stFichierComp)                                    ' existence du fichier archive
 
If stExistFich = "" Then                                            'Si n'existe pas on le crée sous le nom archive& Annee et
    Workbooks.Add
    Set arwbk = ActiveWorkbook                                      ' on nome la première feuille stmois
    Set shm = ActiveSheet
        shm.Name = stMois
        arwbk.SaveAs Filename:=stFichierComp
Else
    Set arwbk = Workbooks.Open(stFichierComp)                           ' si existe
    For Each ws In Worksheets
        If ws.Name Like stMois Then                                     'on cherche si mois existe
            Set shm = ws
            Exit For
        Else
            Set shm = arwbk.Sheets.Add(Type:=xlWorksheet)               'sinon on ajoute une nouvelle feuille du mois
            shm.Name = stMois
        End If
    Next ws
End If
 
        shrq.Range("A4:B11").Copy shm.Cells(1, col)         'adapter la zone à  copier "A4:B11" étant un exemple
 
        arwbk.Save
        arwbk.Close
 
 
Set shm = Nothing
Set arwbk = Nothing
Set shrq = Nothing
Set wbk = Nothing
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

[mercatog]

Effectivement
tu peux mettre ainsi (avec l'ajout d'une variable boolean trouve)

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
Option Explicit
Private Sub btnArch_Click()
 
Dim annee As Integer, i As Integer, col As Integer
Dim stMois As String, stFichier As String, stFichierComp As String, stExistFich As String
Dim wbk As Workbook, arwbk As Workbook
Dim shrq As Worksheet, shm As Worksheet, ws As Worksheet
Dim trouve as boolean
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
Set wbk = ActiveWorkbook
Set shrq = ActiveSheet
 
annee = Year(Date)
stMois = CStr(Format(Date, "mmm"))
 
stFichier = "Archives" & annee & ".xls"                             'Nom Fichier archives
stFichierComp = "C:\Users\user\Desktop\Rapports\" & stFichier       'Nom complet (à adapter)!!!!!!!!!!!!!!!!!!!!!!!
 
Select Case UCase(Trim(Range("C1").Value))                          'recupère la colonne où les données seront copiées!! Les colonnes?
    Case "MATIN": col = 6 * Day(Date) - 4
    Case "SOIR": col = 6 * Day(Date) - 2
    Case "NUIT": col = 6 * Day(Date)
End Select
 
stExistFich = Dir(stFichierComp)                                    ' existence du fichier archive
 
If stExistFich = "" Then                                            'Si n'existe pas on le crée sous le nom archive& Annee et
    Workbooks.Add
    Set arwbk = ActiveWorkbook                                      ' on nome la première feuille stmois
    Set shm = ActiveSheet
        shm.Name = stMois
        arwbk.SaveAs Filename:=stFichierComp
Else
    Set arwbk = Workbooks.Open(stFichierComp)                           ' si existe
    trouve=False
    For Each ws In Worksheets
        If ws.Name Like stMois Then                                     'on cherche si mois existe
            Set shm = ws
            trouve=true
            Exit For
       End If
    Next ws
 
 
       If not trouve then
          Set shm = arwbk.Sheets.Add(Type:=xlWorksheet)               'sinon on ajoute une nouvelle feuille du mois
            shm.Name = stMois
        End If
 
End If
 
        shrq.Range("A4:B11").Copy shm.Cells(1, col)         'adapter la zone à  copier "A4:B11" étant un exemple
 
        arwbk.Save
        arwbk.Close
 
 
Set shm = Nothing
Set arwbk = Nothing
Set shrq = Nothing
Set wbk = Nothing
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

[altra]

Merci bcp, plus rapide que moi.
Ca fonctionne correctement, encore un nouveau truc que je ne connaissais pas.