Discussion :

[LeSqual]

Bonjour

je présente ce que je souhaite faire à l'aide de ma macro :

- ouverture d'un nouveau classeur
- export de tous les onglets de mon classeur en cours vers ce nouveau classeur
- remplacement de texte par un autre (ex "TOTO" remplacé par "TITI")
- enregistrement de mon nouveau classeur sous un nouveau nom

Si je traite onglet par onglet, j'y arrive...mais si je souhaite faire une macro du style For ... each là ca devient galère

je vous montre mon code, si vous pouvez me dire les erreurs ca m'aiderait pas mal

D'avance je vous en remercie

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
Sub export()
 
Dim Feuille As Worksheet
 
Set W1 = ThisWorkbook
nom_fich_travail = W1.Name
Set W2 = Workbooks.Add(xlWBATWorksheet) 'Classeur cible à enregistrer
 
chemin_export = Parametres.Cells(4, 4).Value 'chemin enregistrement nouveau fichier
nom_fichier = Parametres.Cells(5, 4).Value  'nom du fichier export
 
 
' parcours des feuilles de travail
    For Each Feuille In W1.Worksheets
 
  ' Selection de la feuille du fichier source à sauvegarder
    Feuille.Select
 
   ' copie en formules et en format sur le ficher de sauvegarde des données copiées
    Feuille.Copy Before:=W2.Sheets(1)
 
    'on remplace des données confidentielles par une generique
    W1.Feuille.Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
        Selection.Replace What:="TOTO", Replacement:="TITI", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
 
 
Next Feuille
 
Application.Workbooks(nom_fichier & ".xls").Save
Application.Workbooks(nom_fichier & ".xls").Close
 
End Sub

[patricktoulon]

Bonjour
un exemple
on copie les sheets(1,2,3) dans un nouveau classeur et on le nomme "toto.xls"

Code :

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

1
2
3
4
5
6
7
 Application.DisplayAlertsalerts = False
   chemin = "C:\Users\Patrick\Desktop"
       Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Copy
     ActiveWorkbook.SaveAs Filename:=chemin & "\toto.xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close

[LeSqual]

je vois l'exemple

mais je ne pige pas pourquoi la méthode que j'utilise ne marche pas

je ne comprends pas...si vous avez une solution

[Theze]

Bonjour, bonjour Patrick ;-)

Une piste :

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
 
Sub CopieFeuilles()
 
    Dim W1 As Workbook
    Dim W2 As Workbook
    Dim Fe As Worksheet
    Dim Nom_Fichier As String
    Dim Chemin_Export As String
 
    Set W1 = ThisWorkbook
 
    Set W2 = Workbooks.Add(xlWBATWorksheet)
 
    Chemin_Export = Parametres.Cells(4, 4).Value 'chemin enregistrement nouveau fichier <-- Pas utilisé ?
    Nom_Fichier = Parametres.Cells(5, 4).Value  'nom du fichier export
 
    'sélectionne toutes les feuilles du classeurs
    With W1
 
        .Activate
 
        For Each Fe In .Worksheets
 
            Fe.Select False
 
        Next
 
    End With
 
    With W2
 
        'copie les feuilles dans le second classeur
        ActiveWindow.SelectedSheets.Copy , .Worksheets(.Worksheets.Count)
 
        'effectue les remplacements
        For Each Fe In .Worksheets
 
            Fe.UsedRange.Replace "TOTO", "TITI"
 
        Next Fe
 
    End With
 
    'enregistre
'    W2.SaveAs Chemin_Export & Nom_Fichier & ".xls"
'    W2.Close
 
    Application.Workbooks(Nom_Fichier & ".xls").Save
    Application.Workbooks(Nom_Fichier & ".xls").Close
 
End Sub

Hervé.

[LeSqual]

Merci beaucoup

[patricktoulon]

Bonjour LeSqual

theze pour ma part j'eviterais de selectionner tout les sheets(mémoire)

j'utiliserais un array

un peu comme ceci

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
Option Base 1
Sub truc()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wbk1 As Object, wbk2 As Object, feuilles As Variant
Set wbk1 = ThisWorkbook
Dim Nom_Fichier As String, Chemin_Export As String
    Chemin_Export = "C:\Users\Patrick\Desktop\" ' Parametres.Cells(4, 4).Value 'chemin enregistrement nouveau fichier <-- Pas utilisé ?
    Nom_Fichier = "fichier modifié" 'Parametres.Cells(5, 4).Value  'nom du fichier export
ReDim feuilles(wbk1.Sheets.Count)
'on ne select plus les sheets on met leur noms dans un array(tableau)
For i = 1 To UBound(feuilles)
feuilles(i) = Sheets(i).Name
Next
wbk1.Sheets(feuilles).Copy 'on copie toute ls feuilles qui sont dans le tableau
Set wbk2 = ActiveWorkbook 'on a maintenant un 2 eme classeur ouvert
'effectue les remplacements
        For Each Fe In wbk2.Worksheets
             Fe.UsedRange.Replace "TOTO", "TITI"
         Next Fe
' on sauve avec le nom Nom_fichier le 2 eme classeur dans le chemin "chemin_export"
     wbk2.SaveAs Filename:=Chemin_Export & Nom_Fichier & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
wbk2.Close
End Sub

qu'en pense tu ???

[Theze]

Bonjour,

Patrick tu as raison si le classeur comporte un grand nombre de feuille et si le PC est un peu limite

Hervé.