Discussion :

[sagitarium]

Bonjour à tous,

JE suis en train d'écrire une macro qui à partir d'un fichier principal crée un second fichier contenant des onglets du premier fichier.
Pour cela j'ai besoin de copier les onglets d'un fichier à l'autre.
Voici le code que j'utilise:

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
 
Private Sub Extraire_Click()
compt = ThisWorkbook.Worksheets.Count
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlBook1 As Excel.Workbook
Set xlBook1 = ThisWorkbook
 
'On créer l'objet Excel
Set xlApp = CreateObject("Excel.Application")
'On défini le nombre d'onglets (ici 0)
xlApp.SheetsInNewWorkbook = 1
'On ajoute un classeur
Set xlBook = xlApp.Workbooks.Add
'On donne un nom au classeur
xlBook.SaveAs ("Extraction.xls")
'On rend le classeur visible
xlApp.Visible = True
'On créer la page de garde
 
xlBook1.Sheets("Page de garde").Copy xlBook.Sheets("Feuil1")
ActiveSheet.Name = "Liste de Fiches"
 
For r = 5 To compt
 
n = Feuil2.Cells(r, 1)
 
i = InStr(xlBook1.Sheets(r).Cells(1, 3), Specs.Value)
j = InStr(xlBook1.Sheets(r).Cells(1, 4), Projet.Value)
k = InStr(xlBook1.Sheets(r).Cells(1, 5), Produit.Value)
l = InStr(xlBook1.Sheets(r).Cells(1, 6), Fonction.Value)
 
If i > 0 And j > 0 And k > 0 Then
xlBook.Activate
 
 
xlBook.Sheets().Add After:=xlBook.Worksheets(xlBook.Worksheets.Count)
xlBook.Sheets(xlBook.Worksheets.Count).Name = xlBook1.Sheets(r).Cells(1, 1)
xlBook1.Sheets(r).Copy after:=xlBook.Sheets(xlBook.Worksheets.Count)
End If
 
Next r
End Sub

Le problème est que la copie ne fonctionne pas.
Pouvez vous m'éclairer sur le sujet.

Merci d'avance.

[babybell]

Bonjour sagitarium

Pourquoi ne pas faire un simple CopyAs ?

pardon, SaveAS

[aalex_38]

Bonjour,

as-tu essayé le debogueur pas à pas pour savoir ou ça coince, pour moi cette ligne ne fonctionne pas :

Code :

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

xlBook1.Sheets("Page de garde").Copy xlBook.Sheets("Feuil1")

il faudrait faire :

Code :

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

xlBook1.Sheets("Page de garde").Copy after:=xlBook.Sheets("Feuil1")

[babybell]

Si tu veux vraiment créer un deuxième fichier, tu peux aussi faire simple

Code :

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

1
2
3
4
5
6
7
8
    Workbooks.Add
    Windows("Classeur1").Activate
    Sheets("tata").Select
    Sheets("tata").Copy Before:=Workbooks("Classeur2").Sheets(1)
    Windows("Classeur1").Activate
    Sheets("toto").Select
    Sheets("toto").Copy Before:=Workbooks("Classeur2").Sheets(1)
    Windows("Classeur1").Activate

[ouskel'n'or]

Bonjour sagitarium

Pourquoi ne pas faire un simple CopyAs ?

pardon, SaveAS

babybell voulait sans doute dire "SaveCopyAs"
Effectivement, il ne te resterait plus qu'à supprimer les feuilles "en trop"

Code :

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

ActiveWorkbook.SaveCopyAs "C:\Rep\blabla.XLS"

Permet de" rester dans Thisworkbook et de travailler sur blabla.xls
Une question : Pourquoi crées-tu une autre instance d'Excel ? Pour aller plus vite ?

Bon après-midi

[babybell]

Merci ouskel'n'or, j'ai tapé trop vite

Bon AM

[mercatog]

Par contre pour les Windows("Classeur1"), Activate et les Select partout dans la 2ème proposition, je ne vois pas l'utilité

[babybell]

moi non plus, et en plus c'est plus long, mais ça existe

[sagitarium]

Bonjour à tous,

Je n'ai pas pu essayer vos petites astuces jusqu'à aujourd'hui.

Je n'ai pas beaucoup avancer. En effet j'ai réussi à faire une copie entre deux feuille du même fichier.

Mais j'ai toujours la même erreur quand il s'agit d'un second fichier.

Code :

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

xlBook1.Sheets(r).Copy after:=xlBook.Sheets(xlBook.Worksheets.Count)

Je pense que je n'ai pas la main sur le fichier d'où je veux copier les données ou vers lequel j'ai envie de copier les donnée.

Pour rappel, le principe de ma macro est d'extraire des infos à partir d'un fichier et de les copier dans un nouveau fichier.

Si vous avez d'autres façon de réaliser cette copie, je suis ouvert à toute propositions.

Merci.

[babybell]

Salut sagitarium, le Forum

J'ai changé une instruction et ça marche

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
Private Sub Extraire_Click()
compt = ThisWorkbook.Worksheets.Count
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlBook1 As Excel.Workbook
Set xlBook1 = ThisWorkbook
 
   'On créer l'objet Excel
Set xlApp = CreateObject("Excel.Application")
  'On défini le nombre d'onglets (ici 0)
xlApp.SheetsInNewWorkbook = 1
  'On ajoute un classeur
Set xlBook = Workbooks.Add
'On donne un nom au classeur
Application.DisplayAlerts = False
xlBook.SaveAs ("Extraction.xls")
'On rend le classeur visible
xlApp.Visible = True
'On créer la page de garde
 
xlBook1.Sheets("Page de garde").Copy xlBook.Sheets("Feuil1")
ActiveSheet.Name = "Liste de Fiches"
 
For r = 5 To compt
 
n = Feuil2.Cells(r, 1)
 
i = InStr(xlBook1.Sheets(r).Cells(1, 3), Specs.Value)
j = InStr(xlBook1.Sheets(r).Cells(1, 4), Projet.Value)
k = InStr(xlBook1.Sheets(r).Cells(1, 5), Produit.Value)
l = InStr(xlBook1.Sheets(r).Cells(1, 6), Fonction.Value)
 
If i > 0 And j > 0 And k > 0 Then
xlBook.Activate
 
xlBook.Sheets().Add after:=xlBook.Worksheets(xlBook.Worksheets.Count)
xlBook.Sheets(xlBook.Worksheets.Count).Name = xlBook1.Sheets(r).Cells(1, 1)
xlBook1.Sheets(r).Copy after:=xlBook.Sheets(xlBook.Worksheets.Count)
End If
 
Next r
End Sub

[fgiambelluco]

Bonjour

Le problème venait du CreateObject qui ouvre une deuxième instance d'Excel ; ce qui ne permet pas d'utiliser xlBook1.Sheets(r).Copy after:=xlBook.Sheets(xlBook.Worksheets.Count) qui ne fonctionne que dans une même instance d'Excel.
La solution apportée par babybell permet de tout gérer dans la même instance.

[sagitarium]

Merci à tous!
J'ai réussi avec vos astuces à corriger le bug.

A bientôt