Discussion :

[Emily2711]

rebonjour, eh oui je vous embête avec mes questions depuis samedi, voilà donc les 2 questions du jour (qui sont liées) :

Question 1
Je travaille sur 2 fichiers Excel en même temps (tous les 2 ouverts) pour copier des cellules de l'un dans l'autre et autres manip de ce genre.
Le problème est que je ne sais pas comment dire à la macro de passer de l'un à l'autre puisque l'instruction workbooks(2).select ne semble pas exister !
donc j'ai mis l'instruction open mais du coup ça ouvre et ferme le fichier à chaque boucle et donc c'est beaucoup trop long et compliqué.

Question 2
Ci-dessous ma macro (qui fonctionne) mais à laquelle je voudrais ajouter une instruction complémentaire.
Voilà ce qu'elle fait actuellement : pour chaque cellule de la zone du classeur 1, elle va créer un onglet dans le classeur 2 dont le nom sera égal à la valeur de la cellule.
Voilà ce que je veux ajouter : il se peut qu'à l'utilisation une des cellules de la zone du classeur 1 corresponde déjà à un onglet existant dans le classeur 2.
Je voudrais donc anticiper cet éventuel problème en faisant une boucle du type :
pour chaque cellule de la zone du classeur 1 vérifie si un onglet du classeur 2 porte déjà ce nom.
si oui : demander à l'utilisateur s'il souhaite remplacer l'onglet existant
> si l'utilisateur clique oui : alors supprimer au préalable l'onglet existant pour que le nouveau (au même nom) puisse se créer
> si l'utilisateur clique non : alors ne pas essayer d'ajouter l'onglet
si non : ajouter l'onglet normalement


Voilà mon code :

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
 
Public Sub creation_onglet()
 
Dim zone As Range
Dim cell As Variant
Dim numLig As Integer
Dim contenu As String
Dim compteur As Integer
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
numLig = Worksheets(2).Range("A1").CurrentRegion.Rows.Count      'nombre de lignes du tableau
Set zone = Worksheets(2).Range("I2:I" & numLig)                  'la zone va de la 2eme ligne a la derniere ligne de la colonne I
 
Worksheets.Add after:=Worksheets(2)                              'ajoute un onglet a la fin
Worksheets(Worksheets.Count).Name = "LISTE"
Worksheets(2).Rows(1).Copy Worksheets("LISTE").Range("A1")    'copie la ligne d'en-tete dans l'onglet LISTE
 
For Each cell In zone.Cells
    contenu = Worksheets(2).Range("Z" & cell.Row).Value
    If contenu = "Oui" Then
    numLig = Worksheets("LISTE").Range("A1").CurrentRegion.Rows.Count + 1
    Worksheets(2).Rows(cell.Row).Copy Worksheets("LISTE").Range("A" & numLig)  'copie la ligne dans la 1ere ligne vide de l'onglet LISTE
    End If
Next
 
Worksheets("LISTE").Activate
numLig = Worksheets("LISTE").Range("A1").CurrentRegion.Rows.Count      'nombre de lignes du tableau
Set zone = Worksheets("LISTE").Range("I2:I" & numLig)                  'la zone va de la 2eme ligne a la derniere ligne de la colonne I
 
compteur = 0
 
For Each cell In zone.Cells
    Workbooks.Open Filename:="C:\Users\Emily\... \fichier2.xls"
    Worksheets.Add after:=Worksheets(Worksheets.Count)                               'ajoute un onglet a la fin
    Worksheets(Worksheets.Count).Name = cell.Value                                   'l'onglet ajouté prend le nom de la valeur de la cellule
    Worksheets("MODELE").Range("A:A").Copy Worksheets(cell.Value).Range("A:A")       'copie le modele dans le nouvel onglet
    compteur = compteur + 1
    Workbooks(2).Save
Next
 
    Workbooks(1).Save
 
 
    MsgBox prompt:=compteur & " onglets ont ete créés"
 
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub

Question 3
J'aimerai que les onglets se créent non plus si le contenu de la cellule est "Oui" mais si le contenu est la date du jour.
Dans mon fichier les dates sont affichées sous la forme 23/02/2009

merci de votre aide et de votre indulgence (eh oui ce sont mes toutes premières macro)

[Godzestla]

Bonjour,
je n'ai pas regardé ton code mais je peux te dire qu'il ne faut utiliser select.

Bien sûr l'open est a faire une seule fois.

Pour copie direct d'un workbook vers un autre (disponible via aide en ligne VBA sur .copy par ) après la feuille existante "SheetTo"

Code :

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

1
2
 
Workbooks("source").Worksheets("SheetFrom").Copy After:=Workbooks("destination").Worksheets("SheetTo")

[ouskel'n'or]

Je réponds d'abord à la question 1 :
Le plus facile pour travailler sur plusieurs fichiers simultanément est de créer une instance des fichiers en question. Ex
Thisworkbook étant le fichier contenant les macros, NomFich étant la variable contenant le nom du second fichier

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim CL1 as Workbook
Dim CL2 as Workbook
Dim NomFich as string
    NomFich ="D:\Les xls de mon projet\LeClasseur.xls"
    Set CL1 = Thisworkbook
    Set CL2 = Workbooks.open NomFich
 
numLig = CL1.Worksheets(2).Range("A1").CurrentRegion.Rows.Count      'nombre de lignes du tableau
Set zone = CL1.Worksheets(2).Range("I2:I" & numLig)                  'la zone va de la 2eme ligne a la derniere ligne de la colonne I
 
CL1.Worksheets.Add after:=CL1.Worksheets(2)
'etc

Et pour travailler sur le second classeur, tu utilises CL2. Ex :

Code :

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

CL2.Worksheets(2).range("A10:Z15").Copy CL1.Worksheets(1).range("A1")

Tu peux également instancier tes feuilles de calculs et utiliser ces instances pour simplifier ton code.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim CL1 as Workbook
Dim CL2 as Workbook
Dim NomFich as string
    NomFich ="D:\Les xls de mon projet\LeClasseur.xls"
    Set CL1 = Thisworkbook
    Set CL2 = Workbooks.open(NomFich)
Dim FL1 as Worksheet
Dim FL2 as Worksheet
    Set FL1 = CL1.Worksheets(2)
    Set FL2 = CL2.Worksheets(1)
    CL2.FL2.range("A10:Z15").Copy CL1.FL1.range("A1")

Juste pour le principe.
Tu reviens en deuxième semaine pour les questions 2 et 3

[Emily2711]

Merci Ouskel'n'or ... je viens d'essayer mais la ligne :

Code :

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

Set CL2 = Workbooks.open NomFich

se met en rouge, qu'est-ce qui cloche ?

[ouskel'n'or]

J'ai oublié les parenthèses (seulement ici)

Code :

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

    Set CL2 = Workbooks.Open(NomFich)

[Emily2711]

j'ai un message d'erreur "l'indice n'appartient pas à la sélection"

[ouskel'n'or]

C'est que tu as une erreur soit dans le nom du fichier soit dans le chemin. Tu vérifies mais ce coup-ci j'ai testé

[Emily2711]

OK maintenant ça marche et j'ai même ma réponse à la question 3.

Reste plus que la question 2 à traiter ...

[ouskel'n'or]

Je vais te donner "une" solution "pas orthodoxe" mais sans gestion d'erreur
Consiste à concaténer les noms de tes onglets avec un séparateur

Code :

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

1
2
3
4
5
6
Function ListerOnglet() as string
Dim LaFeuille as worksheet
    For each LaFeuille in activeworkbook.worksheets
        ListerOnglet = LaFeuille.name & ", "
    Next
End function

Ainsi tu as tous tes noms de feuilles dans Onglets
Ensuite, pour savoir si une feuille existe

Code :

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

1
2
3
4
5
6
7
Dim Onglets as string
Onglets = ListerOnglets
If not instr(Onglets, "LISTE" & ", ") <> 0 then
     Worksheets.Add after:=Worksheets(2) 'ajoute un onglet a la fin
     Worksheets(Worksheets.Count).Name = "LISTE"
     Onglets = Onglets & "LISTE" & ", "
Endif

A adapter

Avec une gestion d'erreur

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
    On error resume next
    Worksheets("LISTE").activate
    if err.number <> 0 then ' la feuille n'existe pas, on l'ajoute
         Worksheets.Add after:=Worksheets(2) 'ajoute un onglet a la fin
         Worksheets(Worksheets.Count).Name = "LISTE"
      else
         'la feuille existe -> pas d'erreur
         if Msgbox("Remplacer la feuille ?", vbyesno,"") = vbyes then
              Application.displayalerts = false
              Worksheets("LISTE").delete
              Application.displayalerts = True
              Worksheets.Add after:=Worksheets(2) 'ajoute un onglet a la fin
              Worksheets(Worksheets.Count).Name = "LISTE"
            else
              'Quoi qu'on fait ?
         endif
    endif
    on error goto 0

Tu sauras adapter l'un ou l'autre

[Emily2711]

Pour ma question 2 voilà ce que je voulais ajouter :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
For Each cell In zone.Cells
    For Each feuil In CL2.Worksheets
    If cell.Value = feuil.Name Then
    choix = MsgBox("La lettre de " & cell.Value & " existe déjà. Voulez-vous la remplacer ?", vbYesNo, "Confirmation")
        If choix = vbYes Then
        CL2.Worksheets(feuil).Delete
        End If
        If choix = vbNo Then
        CL1.Worksheets("ATTRIBUTIONS").Row(cell.Row).Delete
        End If
    End If
    Next
Next

... mais ça ne fonctionne pas (que je clique oui ou non)
j'ai un message d'erreur "propriété ou méthode non géré par cet objet".
Pouvez-vous me dire ce qu'il faut modifier ?

[ouskel'n'or]

On y va avec une boucle sur le nom des feuilles

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Dim feuil as worksheet
For Each cell In zone.Cells
    For Each feuil In CL2.Worksheets
    If cell.Value = feuil.Name Then
        If  MsgBox("La lettre de " & cell.Value & " existe déjà. Voulez-vous la remplacer ?", _
            vbYesNo, "Confirmation")= vbYes Then
            CL2.Worksheets(feuil).Delete
        else
            CL1.Worksheets("ATTRIBUTIONS").Rows(cell.Row).Delete
        End If
    Next
Next

Dans Rows(cell.Row), ce n'est pas "Row"(cell.Row) mais Rows(cell.Row)
Mais il est possible que le fait de travailler sur deux instances dans une boucle pose des pbs dans certains cas... A tester
Tu dis

[Emily2711]

En fait je suis sur ce pb depuis ce matin 9h et je viens enfin de trouver la solution.

le problème venait du fait que je demande à la macro de comparer des noms de cellules avec des noms d'onglets et selon si l'utilisateur clique "yes" ou "no" supprimer un onglet ou supprimer une ligne.
j'avais donc un message d'erreur qui m'indiquait que la cellule ou l'onglet dont la macro a besoin pour poursuivre la comparaison n'existait plus et donc ça bloquait la boucle.

donc j'ai ajouté quelques spécificités :
- quand je supprime une ligne je redéfinis la zone tout de suite après pour ne pas que la macro cherche indéfiniment une cellule de la ligne supprimée
- quand je souhaite supprimer un onglet je le renomme "suppr" et je le supprime seulement une fois que la boucle est terminée.

je commençais vraiment à désespérer mais ça marche enfin.
maintenant il me reste 1h pour trouver comment enregistrer sous .pdf et envoyer par email (cf mon autre sujet).