pb dans macro

[darib52]

bonjour à tous,
j'ai un p'tit souci dans la macro qui suit.
je dois copier une sélection word dans une feuille excel. pas de pb.
pour celà j'utilise une feuille nommée 'modele'.
la macro ci-dessous réalise bien cette opération .
mais en plus, elle créée à chaque fois une nouvelle feuille 'feuil1'
j'imagine que ça a à voir avec 'sheets-add' mais je n'arrive pas à supprimer la création de cette feuille supplémentaire.
si l'un d'entre vous pouvait me donner la solution.
merci d'avance.
amicalement

Sub Bouton2_QuandClic()
Dim Wrd As Object

Application.ScreenUpdating = False

Set Wrd = CreateObject('word.application')
Wrd.Visible = False
monChemin = InputBox('Saisissez le chemin complet', '')
Wrd.documents.Open (monChemin)
Wrd.Selection.WholeStory
Wrd.Selection.Copy
Sheets('modele').Copy after:=ActiveWorkbook.Sheets.Add
Do
Nom = InputBox('Entrez un nom pour la nouvelle feuille :')
If Nom = '' Then Exit Sub
On Error Resume Next
Set sht = Sheets(Nom)
If Err <> 0 Then

ActiveSheet.Name = Nom
Err.Clear: Exit Do
Else
MsgBox 'Une feuille de ce nom existe déjà !'
End If
Loop
Range('a1').Select
ActiveSheet.Paste
Wrd.Application.Quit
Range('G7').Select
Columns('A:A').ColumnWidth = 34.86
ActiveWindow.SmallScroll Down:=48
Range('A53😀60').Select
Selection.EntireRow.Delete
ActiveWindow.SmallScroll Down:=30
Range('A88😀97').Select
Selection.EntireRow.Delete
ActiveWindow.SmallScroll Down:=45
Range('A1:A133').Select
Selection.RowHeight = 25
End Sub

 

[herve62]

Salut

Remplace ton instruction 'Sheets....copy after......' par simplement
Sheets.add
J'ai testé ca marche
A+
Hervé

 

[darib52]

merci

 

[darib52]

merci