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

[altra]

Bonjour et merci,

Je regarde ça dés que j'ai réussi à régler le problème avec mon erreur 336 voir ce post
Mais en tous cas merci pour le mal que tu donnes pour m'aider.

[altra]

Re,

J'ai reussi à changer de poste, pendant que l'autre est reinstallé.

Alors

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.

C'est bien ça, on s'est compris.

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)

La encore on est d'accord, et effectivement je n'ai pas encore réfléchis à ajouter un mois au classeur. Je voulais d'abord correctement tout faire fonctionner pour un mois, c'est à dire placement dans la feuille, copie correcte.


Je viens d'essayer ton code, et il est pratiquement parfait.
Apparemment tu prends en compte le changment de mois, donc ça c'est fait.
Quelques petites bricoles à rajouter.
Il faut, lors de la copie, tenir compte du format des cellules (apparement ce point fonctionne) ainsi que de la taille des cellules (largeur colonne et hauteur ligne). Il existe un collage spécial pour adapter la largeur des colonnes

Code :

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

1
2
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

, mais je ne sais pas s'il existe la même chose pour les hauteurs de lignes du style

Code :

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

xlPasteRowHigh

c'est pour ça en fait que je voulais copier entierement l'onglet (avec toutes les bonnes dimensions pour mes cellules) pour mon premier archivage du mois et ainsi les prochains archivages pourront se coller dans des cellules avec de bonnes dimensions. Voila c'était ma manière pour contourner le fait que je ne pouvais pas coller la hauteur de ligne, mais peut etre qu'il existe une autre solution.

Dans tous les cas merci, tu m'as bien avancé, je vais faire les quelques modifs que je peux.

[mercatog]

Pourquoi copier la mise en forme alors que tu peux facilement ajouter une petite procédure après la copie de tes données! (et aussi pour uniformiser la mise en forme partout). si c'est seulement la largeur des colonnes ou hauteur des lignes
à toi de voir!

[altra]

Ouais, c'est une bonne idée.
Je vais essayer de faire ça avec une boucle ou je sais pas quoi.

En fait la largeur des colonnes est bien copiée aussi, uniquement la hauteur des lignes n'est pas prise en compte.

Merci encore une fois pour ton aide.

Je peux marquer ce problème comme résolu maintenant je pense.

Ah bientot sur un autre topic à mon avis

[mercatog]

évites les boucles si ce n'est pas nécessaire

Code :

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

Range("A4:A11").RowHeight = 24

ou

Code :

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

Rows("4:11").RowHeight = 24

permet de mettre les lignes de 4 à 11 à la hauteur 24

Bon courage pour la suite donc

[altra]

Bonjour,

Il s'avère qu'il y a un petit problème avec cette boucle

Code :

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

1
2
3
4
5
6
7
8
9
    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

Cette boucle s'execute si le classeur existe deja, donc il y a déja des feuilles dans ce classeur.
Admettons pour l'explication que le classeur contient déjà les feuilles "juin 2009" "juillet 2009" et "août 2009". Je suis encore au mois d'aôut et j'appuie par erreur sur le bouton pour archiver.
La boucle va procéder comme suit:
elle compare si le nom de la premiere feuille "juin 2009" et comme "aout 2009" contenu dans la variable st Mois.
"juin 2009" et "août 2009" étant différent il ajoute une nouvelle feuille et lorsqu'il veut renommer la feuille par "août 2009" la macro bug puisque cette feuille existe déjà.

En fait il faudrait mettre le Next ws juste aprés la premiere condition pour qu'il puisse comparer toutes les feuilles du classeur avec la feuille copiée.

Ou peut etre le faire avec select case(je viens d'y penser), mais je n'ai pas encore essayer

Toute proposition sera la bienvenue, je vais continuer à chercher de mon coté.

En vous remerciant.

[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.