Discussion :

[babilou]

Bonjour, je n'y connais rien en VBA.
Mais en fouillant sur le net j'ai partiellement solutionné mon problème mais la je bloque.

Dans la colonne A d'un feuille, j'ai une liste de noms. Je souhaite créer pour chacun de ces noms une feuille portant ce nom et étant la copie d'un feuille nommé original.

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
Private Sub CommandButton1_Click()
 
Dim z As Integer
Dim shessai2 As Worksheet
 
For z = 1 To Range("A65536").End(xlUp).Row
 
If Not IsEmpty(Cells(z, 1)) Then
  If Not exist_f(Cells(z, 1)) Then
    Set copie = Sheets.Add(After:=Sheets(Sheets.Count))
 
    copie.Name = Cells(z, 1).Value
 
  End If
End If
 
Next z
End Sub
 
 
Function exist_f(feuille)
For Each sh In Sheets
  If sh.Name = feuille Then
    exist_f = True
    Exit Function
  End If
Next
exist_f = False
End Function

Mon essais permet juste de créer une feuille par nom mais je n'arrive pas à copier le contenu de l'original dans chaque feuille.
Merci pour votre aide.

[Aposto]

Bonjour à tous,

as t-u essayé en utilisant la fonction copy 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
27
28
29
30
Private Sub CommandButton1_Click()
 
Dim z As Integer
Dim shessai2 As Worksheet
 
For z = 1 To Range("A65536").End(xlUp).Row
 
If Not IsEmpty(Cells(z, 1)) Then
  If Not exist_f(Cells(z, 1)) Then
    Set copie = Sheets.Add(After:=Sheets(Sheets.Count))
 
    copie.Name = Cells(z, 1).Value
Sheets("original").usedRange.Copy Destination:=copie.Range("A1")
 
  End If
End If
 
Next z
End Sub
 
 
Function exist_f(feuille)
For Each sh In Sheets
  If sh.Name = feuille Then
    exist_f = True
    Exit Function
  End If
Next
exist_f = False
End Function

n'hésites pas si tu as d'autres questions

[babilou]

Et bien merci, ca répond à mon problème de copie.
Par contre, il ne conserve pas la mise en forme originale. Y a t il un moyen de la récupérer?
Merci

[Nico Chg]

Bonjour,

Pour garder la mise en forme, il faut copier la feuille entière, et pas la range contenue dans la feuille Original !
Attention si tu as des noms liées à la feuille Original dont l'étendue est égal au classeur entier.

Code :

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

1
2
3
4
worksheets("original").Copy After:=ThisWorkbook.Sheets(1)
'Copie de la feuille "original" en seconde position (après la feuille 1)
WB_Report.Sheets(2).Name = ThisWorkbook.Sheets(1).cells(1, 1)
'Renomme la feuille nouvellement copiée d'après la cellule A1 de la feuille 1

A adapter suivant ton cas !

[Aposto]

alors ça c'est bizare, chez moi cela marche très bien

Même avec UsedRange, que je viens de tester. Moi, dans ma macro j'utilise range("A2:N2").

aurais-je eu de la chance ?

je précise que j'utilise Excel 2010.

[babilou]

Merci pour votre aide.

Pour Aposto: Moi aussi je suis en 2010 mais la mise en page de la feuille original n'est pas conservée

Pour Mercatog: le soucis avec ce code, c'est que les feuilles crées portent le nom du contenu de la colonne A de la feuille origonale et non celui de la feuille "Liste".
Pour Nico Chg: je suis vraiment nul mais incorporé ces fonction dans mon code donne des résultats plutot exotiques!!!

merci quand meme pour ces pistes.

[mercatog]

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
Private Sub CommandButton1_Click()
Dim z As Long
 
With Worksheets("original")
    For z = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(z, 1) <> "" Then
            If Not Exist_F(.Cells(z, 1)) Then
                .Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = .Cells(z, 1).Value
            End If
        End If
    Next z
End With
End Sub
 
 
Function Exist_F(ByVal Feuille As String) As Boolean
 
On Error Resume Next
Exist_F = Sheets(Feuille).Index
End Function