Problème copie d'objets via macro

[titymax]

Bonjour,

Comme indiqué dans le titre, j'ai un souci avec une macro qui pourtant ne fait que copier une feuille type en la renommant suivant le nom sélectionner. Or, cette feuille type contient 2 objets qui ne sont plus présents une fois la copie effectuée.

Je joins un fichier simplifié de mon fichier de travail, afin que vous puissiez me donner une solution. Dans ce fichier, la feuille type s'appelle "BILAN".

Pourriez vous m'aider, merci.

A bientôt

 

[simraill]

Re : Problème copie d'objets via macro

Bonjour titymax,

En fait ton erreur venait du fait que tu copiais seulement les cellules de la feuille, donc sans les boutons.
La solution était de copier la feuille elle-même

Sheets("BILAN").copy after := Sheets(Sheets.count)

J'ai donc modifié un peu ton module 9 et le code de ton useform "NOUVELIMPORT"

Simraill

 

[titymax]

Re : Problème copie d'objets via macro

Bonjour Smiraill,

Merci bcp de votre réponse, pourriez vous mettre en PJ le fichier modifié afin que je ne fasse pas de bêtise en essayant de modifier le mien.

Merci.

 

[simraill]

Re : Problème copie d'objets via macro

Apparemment le fichier est trop gros pour le forum !! Je ne comprend pas comment tu as pu le mettre et moi non
Donc voici les modifications que j'ai faite :
Dans NOUVELIMPORT :

Private Sub CommandButton2_Click()
Dim I As Integer
nomfeuille = ComboBox1
TestFeuilleExiste
Application.ScreenUpdating = False
Sheets("LISTES").Visible = True
Sheets("BILAN").Visible = True
Sheets("BILAN").Copy After:=Sheets(Sheets.Count) '**** Copie de la feuille elle même et coller après la dernière
Sheets(Sheets.Count).Name = nomfeuille '**** renommage de la feuille
Sheets(nomfeuille).Select
ActiveWindow.zoom = 113
Range("A1").Select

Dans le module 9 :

Public nomfeuille As String
Sub TestFeuilleExiste()
Application.DisplayAlerts = False
If Not FeuilleExiste(nomfeuille) Is Nothing Then Sheets(nomfeuille).Delete
'ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count) '**** La copie est faite dans NOUVELIMPORT
'ActiveSheet.Name = nomfeuille '**** Le renomage est fait dans NOUVELIMPORT
'fin:
'Set feuille = Worksheets("Tata")
'feuille.Activate
Application.DisplayAlerts = True
End Sub
Function FeuilleExiste(f As String) As Worksheet
On Error Resume Next
Set FeuilleExiste = Worksheets(f)
End Function

Il te suffit de coller au bon endroit. Pour le module j'ai mis tout la sub, mais pour NOUVELIMPORT je n'ai copié que le début car je n'ai pas modifié après.

Simraill

 

[kjin]

Re : Problème copie d'objets via macro

Bonjour,
QQ peu remanié....

Private Sub CommandButton2_Click()
Dim i%, nomfeuille$, rng As Range
If ComboBox1.ListIndex = -1 Then Exit Sub
nomfeuille = ComboBox1
Application.ScreenUpdating = False
Sheets("LISTES").Visible = True
Sheets("BILAN").Visible = True

On Error Resume Next
Application.DisplayAlerts = False
Sheets(nomfeuille).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Sheets("BILAN").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = nomfeuille

With Sheets("ACCUEIL")
    .Activate
    .Columns(1).Cells.Clear
    For i = 7 To Sheets.Count
        .Range("A" & i - 6).Hyperlinks.Add Anchor:=.Range("A" & i - 6), Address:="", _
            SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
    Next
    Set rng = .Range("A1:A" & .Range("A65000").End(xlUp).Row)
    If rng.Count > 1 Then
        rng.Sort Key1:=rng.Cells(1), Order1:=xlAscending, Header:=xlGuess
    End If
End With
With Sheets("LISTES")
    .Range("F2:F1000").Clear
    .Range("F2:F" & rng.Count + 1) = rng.Value
End With

Sheets("BILAN").Visible = False
Sheets("LISTES").Visible = False
Application.ScreenUpdating = True
End Sub

Note que "TestFeuilExiste" ne sert plus dans ce cas
A+
kjin

 

[titymax]

Re : Problème copie d'objets via macro

Bonjour,

Je n'aurais qu'un mot M E R C I !!!!!!

Je suis enfin arrivé à mes fins grâce à vous et je vous en suis hyper reconnaissant, c'est vraiment génial !

Ce forum est excelENTISSIME-download tout simplement !!

Kjin je n'ai pas encore testé votre code mais je suppose qu'il doit fonctionné, dès que j'ai le temps je ferai des essais et vous tiens au courant.

Bonne continuation à tous et longue vie à ce forum et tous ces participants...

A bientôt