Enregister plusieurs feuilles d'un classeur dans un autre classeur

**ghazalinadou** · 28/08/2017, 22h01

Envoyé par parmi

Peux-tu être plus claire un peu?
N'oublie pas que je ne connais pas ton classeur...

Vous avez reçu mon classeur ?

**parmi** · 29/08/2017, 01h44

Oui, tu as bien joint un fichier, mais je ne peux l'ouvrir au bureau, question de sécurité.
J'ai essayé de l'ouvrir chez moi, mais j'ai un message qui me dit que le fichier a un problème et qu'Excel peut essayer de le corriger si je fais confiance au dit fichier... alors... je ne l'ouvre pas.

Essaie plutôt de bien expliquer ton problème, de mettre le code que tu essaies et de dire ce qui ne va pas.
S'il y a un message d'erreur, donne le numéro de ligne où l'erreur se produit ainsi que ce message.
S'il n'y a pas de message d'erreur, explique ce qui ne va pas de façon claire et précise.

**ghazalinadou** · 29/08/2017, 13h54

je pense avec le classeur c'est mieux pour me comprendre, je ne sais pas pourquoi ca s'ouvre pas , essaye encore avec ce fichier sans aucun code je mets les codes ci-dessous :

Module 1:

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
 
Sub Execution()
Dim chemin As String
Dim MyDate As String
Dim sNomfichier As String
 
    MyDate = Format(Now(), "dd-mm-yy")
    chemin = ActiveWorkbook.Path
 
    sNomfichier = RenommerFichier(chemin, "Synthèse carnet" & "-" & MyDate & ".xlsb")
 
    ActiveWorkbook.SaveAs Filename:=sNomfichier, FileFormat:=xlExcel12
    ActiveWorkbook.Close savechanges:=True
End Sub
 
Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FileExists(sDossier & "\" & sNomfichier) Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)
 
        i = 0
        While FSO.FileExists(sDossier & "\" & sNouveauNom)
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing
 
    RenommerFichier = sDossier & "\" & sNomfichier
End Function

Module 2

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 IST()
Sheets("IST").Visible = True
Sheets("IST").Select
End Sub
Sub ISP_Cliquer()
Sheets("ISP").Visible = True
Sheets("ISP").Select
 
 
End Sub
Sub BesoinNacelle_Cliquer()
Sheets("besoin Nacelle").Visible = True
Sheets("besoin Nacelle").Select
End Sub
Sub besoinEchafaudage_Cliquer()
Sheets("besoin Echafaudage").Visible = True
Sheets("besoin Echafaudage").Select
End Sub
Sub besoinGrue_Cliquer()
Sheets("besoin Grue").Visible = True
Sheets("besoin Grue").Select
End Sub
 
Sub bilanSF6Chantier_Cliquer()
Sheets("bilan SF6 Chantier").Visible = True
Sheets("bilan SF6 Chantier").Select
 
Dim nbLignes As Long
 
With Sheets("Dossier chantier postes hors T")
   nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 'la première ligne vide en colonne A
   .Range("A" & nbLignes) = nbLignes - 1  'numéro si l'entête est en ligne 1
   .Range("B" & nbLignes) = "bilan SF6 Chantier"
End With
End Sub

le problème comment je me positionner sur le bon endroit car j'ai des tableau que peuvent être variable en dessus de mon tableau ou je veux mettre çad sur feuille (dossier chantier postes hors tension ) j'ai mets des commentaire dans classeurs

**parmi** · 30/08/2017, 11h53

Je sujet est de copier des onglets sous un autre classeur.
Je pense que j'ai bien répondu à cette question...(?)

Si ça ne fonctionne pas à ton goût, explique ce qui ne va pas et ce qui devrait se passer.

Si tu as d'autres problèmes que la copie d'onglets, ouvre une autre discussion pour ne pas qu'on se perde...

**patricktoulon** · 30/08/2017, 12h05

Bonjour
salut parmi
perso j'ai suivi de loin j'ai du mal a comprendre une telle difficulté surtout que je sais toujours pas ce que veux dire "sous un autre classeur"

un nouveau
un existant

avec l'enregistreur de macro tu quasiment un code tout fait que tu peux arranger a ta sauce

exemple ici je sauve 3 feuille dans un nouveau classeur

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
Sub test()
Dim Chemin$, NewNom$
Chemin = "C:\Users\polux\Desktop\"
NewNom = "mes feuilles sauvées.xls"
    Sheets(Array("toto", "titi", "rififi")).Copy
 
    ActiveWorkbook.SaveAs Filename:= _
       Chemin & NewNom, FileFormat:=xlExcel8, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
End Sub

**ghazalinadou** · 30/08/2017, 14h16

j'ai résolu le problème par rapport au enregistrement , mais en fait je veux bien a coté de ça que lorsque je click par exemple sur bouton ISP , j'ai un tableau que sera rempli dans une feuille (nommée Dossier chantier postes hors T) comme indiquer sur photo en bas:
Nom : 88.JPG
Affichages : 146
Taille : 19,7 Ko

Nom : 88.JPG
Affichages : 146
Taille : 19,7 Ko

**parmi** · 31/08/2017, 17h14

Tu as 6 lignes de libres sous Libellé
Qu'est-ce que tu fais si les lignes sont toutes remplies ?

Autrement, tu fais une recherche sur ce mot et tu sais où tu te situes dans la feuille

Code :

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

1
2
3
4
5
6
7
8
    Dim Recherche As Range
 
    Set Recherche = Sheets("Dossier chantier postes hors T").Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
    If Not Recherche Is Nothing Then
        MsgBox "On peut écrire sur la ligne " & Recherche.Row + 1 & " si elle n'est pas déjà remplie"
    End If
 
    Set Recherche = Nothing

**ghazalinadou** · 01/09/2017, 00h08

oui je eux avoir plus de 6 donc on fais insertion, donc c'est pour ca je dis que les tableaux ne sont pas fixe , et donc je besoin d'aide. Est ce que vous aviez compris mon probleme ??

**ghazalinadou** · 01/09/2017, 14h12

Ce code je l'ajoute ou et comment je peux le remplir de façon automatiquement en faisant a chaque fois un appel a une feuille depuis un click sur bouton de ma page sommaire , çàd lorsque je click sur besoin grue
cava aller remplir automatiquement sur ce tableau et l'incrémente numéro selon page appelés

Code :

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

1
2
3
4
5
6
7
8
9
 
Dim Recherche As Range
 
    Set Recherche = Sheets("Dossier chantier postes hors T").Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
    If Not Recherche Is Nothing Then
        MsgBox "On peut écrire sur la ligne " & Recherche.Row + 1 & " si elle n'est pas déjà remplie"
    End If
 
    Set Recherche = Nothing

j'essayé ça mais il le remplis pas dans le bon endroit

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
 
 
 
Sub bilanSF6Chantier_Cliquer()
Sheets("bilan SF6 Chantier").Visible = True
Sheets("bilan SF6 Chantier").Select
 
Dim nbLignes As Long
 
With Sheets("Dossier chantier postes hors T")
   nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 'la première ligne vide en colonne A
   .Range("A" & nbLignes) = nbLignes - 1  'numéro si l'entête est en ligne 1
   .Range("B" & nbLignes) = "bilan SF6 Chantier"
End With
End Sub

**parmi** · 01/09/2017, 14h31

Essaie 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
Sub bilanSF6Chantier_Cliquer()
    Dim Recherche As Range
 
    Sheets("bilan SF6 Chantier").Visible = True
    Sheets("bilan SF6 Chantier").Select
 
    With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
            .Range("A" & Recherche.Row + 1) = 1     'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "SF6" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub

**ghazalinadou** · 03/09/2017, 21h46

Ca fonctionne bien par contre j'ai beosin d'aide sur la remplissage automatique , je fais un autre discussion mais j'ai pas de retour voila le lien
https://www.developpez.net/forums/d1...te-deroulante/

**ghazalinadou** · 04/09/2017, 10h37

Bonjour,
Encore je reviens sur la discussion a propos remplissage de tableau , il prend toujours le numéro 1 , donc je fais cette essayé mais il commence par numéro 119: j'ai obtient un tableau comme suivant :
Nom : incrmmm.JPG
Affichages : 159
Taille : 35,3 Ko

Nom : incrmmm.JPG
Affichages : 159
Taille : 35,3 Ko

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
 
Sub IST()
Dim Recherche As Range
Sheets("IST").Visible = True
Sheets("IST").Select
Dim nbLignes As Long
 With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
            nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & Recherche.Row + 1) = nbLignes     'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "IST" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub
Sub ISP_Cliquer()
Dim Recherche As Range
Sheets("ISP").Visible = True
Sheets("ISP").Select
 Dim nbLignes As Long
 With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
           nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & Recherche.Row + 1) = nbLignes    'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "ISP" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub
Sub BesoinNacelle_Cliquer()
Dim Recherche As Range
Sheets("besoin Nacelle").Visible = True
Sheets("besoin Nacelle").Select
Dim nbLignes As Long
 With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
             nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & Recherche.Row + 1) = nbLignes    'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "Nacelle" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub
Sub besoinEchafaudage_Cliquer()
Dim Recherche As Range
Sheets("besoin Echafaudage").Visible = True
Sheets("besoin Echafaudage").Select
Dim nbLignes As Long
 With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
          nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & Recherche.Row + 1) = nbLignes     'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "Echafaudage" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub
Sub besoinGrue_Cliquer()
Dim Recherche As Range
Sheets("besoin Grue").Visible = True
Sheets("besoin Grue").Select
Dim nbLignes As Long
 With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
             nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & Recherche.Row + 1) = nbLignes    'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "Grue" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub
 
'Sub bilanSF6Chantier_Cliquer()
'Sheets("bilan SF6 Chantier").Visible = True
'Sheets("bilan SF6 Chantier").Select
 
'Dim nbLignes As Long
 
'With Sheets("Dossier chantier postes hors T")
 '  nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 'la première ligne vide en colonne A
  ' .Range("A" & nbLignes) = nbLignes - 1  'numéro si l'entête est en ligne 1
   '.Range("B" & nbLignes) = "bilan SF6 Chantier"
'End With
'End Sub
Sub bilanSF6Chantier_Cliquer()
    Dim Recherche As Range
    Dim Find As Range
    Sheets("bilan SF6 Chantier").Visible = True
    Sheets("bilan SF6 Chantier").Select
 
 Dim nbLignes As Long
    With Sheets("Dossier chantier postes hors T")
        Set Recherche = .Columns("B").Find("LIBELLE", LookIn:=xlValues, LookAt:=xlWhole)
        Set Find = .Columns("B").Find("N°", LookIn:=xlValues, LookAt:=xlWhole)
        If Not Recherche Is Nothing Then
            .Rows(Recherche.Row + 1).Insert
            nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Range("A" & Recherche.Row + 1) = nbLignes     'pas certain du numéro que tu veux mettre
            .Range("B" & Recherche.Row + 1) = "SF6" 'ni du nom
        End If
    End With
 
    Set Recherche = Nothing
End Sub

**ghazalinadou** · 04/09/2017, 22h36

vous pouviez le voir avec moi svp

**parmi** · 04/09/2017, 23h38

Pour pouvoir t'aider, ça prend des explications très claires, ce que tu ne sembles pas capable de faire...

Enregister plusieurs feuilles d'un classeur dans un autre classeur

Macros et VBA Excel

Discussions similaires

Partager

Partager