Discussion :

[pasterlouis]

Bonjour,
j'ai modifié et adapté cette macro que m'a filé KERGRESSE.
je veux qu'elle me copie la dernière ligne de ma feuille "suivis etudes" et la colle dans la feuille du client concerné. cette macro(en dessous) me copie bien la ligne mais me la colle souvent à la feuille active.
j'ai essayé

Code :

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

shNouveau.activate

pour activer la feuille de destination mais il me fait erreur à deboger.

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
Sub CreationCCC()
 
Dim ShClients As Worksheet
Dim shNouveau As Worksheet
Dim ShModele As Worksheet
Dim CelluleClient As Range
Dim NomNouvelleFeuille As String
Dim DerLig As Long
Dim DerniereColonneACopier As Long
Dim derl As Integer
Dim worksheetIsExist As Boolean
 
         ' Identification de la feuille Clients
         Set ShClients = Sheets("suivis etudes")
 
         DerLig = ShClients.Cells(ShClients.Rows.Count, 1).End(xlUp).Row
         DerniereColonneACopier = 22
 
         Set CelluleClient = ShClients.Cells(DerLig, 11) '*localisation
 
    For Each shNouveau In Worksheets
        If shNouveau.Name = CelluleClient Then
            worksheetIsExist = True
        End If
    Next shNouveau
 
    If worksheetIsExist = True Then GoTo suivant
 
    If worksheetIsExist = False Then
         Set ShModele = Sheets("Modèle")
 
          ' Création d'une nouvelle feuille client à partir du modèle
         ShModele.Copy after:=Sheets(Sheets.Count)  ' On place la nouvelle feuille en dernier
        ' Création d'une nouvelle feuille client
 
         Set shNouveau = ActiveSheet
         shNouveau.Name = CelluleClient
 
suivant:
         ' Copie des informations de la feuille clients sur la nouvelle feuille client
         Range(ShClients.Cells(CelluleClient.Row, 1), ShClients.Cells(CelluleClient.Row, DerniereColonneACopier)).Copy
        derl = Range("A65536").End(xlUp).Row + 1
 
        'shNouveau.Activate
        Set shNouveau = ActiveSheet
         shNouveau.Cells(derl, 1).Select
         shNouveau.Paste
    End If
         Set ShModele = Nothing
         Set CelluleClient = Nothing
         Set shNouveau = Nothing
         Set ShClients = Nothing
 
End Sub

je vous remercie de bien vouloir m'aider svp

[casefayere]

Bonjour,Sans avoir testé, essaies ton code modifié légèrement (j'espère ne rien oublier)

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
Sub CreationCCC()
 
Dim ShClients As Worksheet
Dim shNouveau As Worksheet
Dim ShModele As Worksheet
Dim CelluleClient As Range
Dim NomNouvelleFeuille As String
Dim DerLig As Long
Dim DerniereColonneACopier As Long
Dim derl As Integer
Dim worksheetIsExist As Boolean
 
' Identification de la feuille Clients
Set ShClients = Sheets("suivis etudes")
 
DerLig = ShClients.Cells(ShClients.Rows.Count, 1).End(xlUp).Row
DerniereColonneACopier = 22
Set CelluleClient = ShClients.Cells(DerLig, 11) '*localisation
 
For Each shNouveau In Worksheets
  If shNouveau.Name = CelluleClient Then
    worksheetIsExist = True
    Exit For
  End If
Next shNouveau
 
If worksheetIsExist = True Then
    ' Copie des informations de la feuille clients sur la nouvelle feuille client
  With ShClients
    .Range(.Cells(CelluleClient.Row, 1), .Cells(CelluleClient.Row, DerniereColonneACopier)).Copy
    derl = .Range("A" & .Rows.Count).End(xlUp).Row + 1
  End With
  Set shNouveau = Sheets(CelluleClient)
  shNouveau.Cells(derl, 1).Select
  shNouveau.Paste
Else
  Set ShModele = Sheets("Modèle")
    ' Création d'une nouvelle feuille client à partir du modèle
  ShModele.Copy after:=Sheets(Sheets.Count)  ' On place la nouvelle feuille en dernier
        ' Création d'une nouvelle feuille client
  Set shNouveau = ActiveSheet
  shNouveau.Name = CelluleClient
End If
Set ShModele = Nothing
Set CelluleClient = Nothing
Set shNouveau = Nothing
Set ShClients = Nothing
 
End Sub

[pasterlouis]

merci d'avoir répondu,
il met une erreur d'exécution au niveau de

Code :

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

Set shNouveau = Sheets(CelluleClient)

Parcontre moi j'avais déja essayé

Code :

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

Set shNouveau = Sheets("'" & CelluleClient & "'")

mais ça ne marche pas non plus

[casefayere]

comme j'ai mis un "exit for" à cet endroit

Code :

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

1
2
3
4
5
6
7
8
.....
For Each shNouveau In Worksheets
  If shNouveau.Name = CelluleClient Then
    worksheetIsExist = True
    Exit For
  End If
Next shNouveau
.......

peut-être, suffit'il de vérifier la valeur de "shNouveau" et adapter, soit glisser un :

Code :

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

MsgBox shNouveau.name

et si la réponse est correcte, adapter le code :

Code :

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

1
2
3
4
5
6
7
 With ShClients
    .Range(.Cells(CelluleClient.Row, 1), .Cells(CelluleClient.Row, DerniereColonneACopier)).Copy
    derl = .Range("A" & .Rows.Count).End(xlUp).Row + 1
  End With
  MsgBox shNouveau.Name'une fois vérifié
  shNouveau.Cells(derl, 1).Select
  shNouveau.Paste

[rvtoulon]

bonjour remplace:

Code :

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

Set shNouveau = Sheets(CelluleClient)

par:

Code :

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

Set shNouveau = Sheets(CelluleClient.value)

[pasterlouis]

je suis désolé mais ça ne marche pas

[rvtoulon]

je te retourne le code qui tient code de la bonne remarque de casefayere sur le exit for dans la boucle et fait quelques modifications.
a voir :

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
Sub CreationCCC()
 
Dim ShClients As Worksheet
Dim shNouveau As Worksheet
Dim ShModele As Worksheet
Dim CelluleClient As Range
Dim NomNouvelleFeuille As String
Dim DerLig As Long
Dim DerniereColonneACopier As Long
Dim derl As Integer
Dim worksheetIsExist As Boolean
 
         ' Identification de la feuille Clients
         Set ShClients = Sheets("suivis etudes")
 
         DerLig = ShClients.Cells(ShClients.Rows.Count, 1).End(xlUp).Row
         DerniereColonneACopier = 22
 
         Set CelluleClient = ShClients.Cells(DerLig, 11) '*localisation
 
    For Each shNouveau In Worksheets
        If shNouveau.Name = CelluleClient Then
            worksheetIsExist = True
            Exit For
        End If
    Next shNouveau
 
If worksheetIsExist = True Then
    GoTo suivant
 
Else
    Set ShModele = Sheets("Modèle")
 
    ' Création d'une nouvelle feuille client à partir du modèle
    ShModele.Copy after:=Sheets(Sheets.Count)  ' On place la nouvelle feuille en dernier
    ' Création d'une nouvelle feuille client
 
    ActiveSheet.Name = CelluleClient.Value
    Set shNouveau = ActiveSheet
 
 
End If
suivant:
           ' Copie des informations de la feuille clients sur la nouvelle feuille client
       derl = shNouveau.Range("A65536").End(xlUp).Row + 1
 
ShClients.Range(ShClients.Cells(CelluleClient.Row, 1), ShClients.Cells(CelluleClient.Row, DerniereColonneACopier)).Copy shNouveau.Cells(derl, 1)
 
 
 
         Set ShModele = Nothing
         Set CelluleClient = Nothing
         Set shNouveau = Nothing
         Set ShClients = Nothing
 
End Sub

[pasterlouis]

Merci beaucoup rvtoulon ta modification marche très bien. merci a tous ceux qui ont participé. vous etes formidables.
encore merci