Comment copier une feuille EXCEL sous ACCESS?

Bonjour à tous, voici mon problème je n'arrive pas à copier le contenu d'une feuille EXCEL dans une autre feuille EXCEL du meme classeur.



Je dois transférer une table ACCESS vers EXCEL, bon ça j'y arrive je transfère ma table ACCESS (toute les semaines) vers la feuille EXCEL (SXX) et cette feuille ainsi créer doit être copier dans le meme classeur dans la feuille S0, en gros je dois avoir 2 feuilles identiques dans le meme classeur mais sous 2 noms différents, et j'aimerais également mettre mes champs si possible.



Je met pour l'instant pour mon code si ça peut vous aider.



Je vous remercie d'avance pour votre aide.

Option Compare Database

 Sub ExportTblAccessInExcel()

Dim Db As DAO.Database

Dim Rs As DAO.Recordset

Dim Xlapp As Excel.Application

Dim XlBook As Excel.Workbook

Dim XlSheet As Excel.Worksheet

Dim NomFeuille As String

Dim LigneCopiees As Long

On Error GoTo errOuvrirExcel

Set Xlapp = GetObject(, "Excel.Application")

 'On Error GoTo oups:

On Error GoTo 0

Xlapp.Visible = True

NomFeuille = "S" & DatePart("ww", Date) - 1



Set XlBook = Xlapp.Workbooks.Open("C:\Documents and Settings\A4382\Bureau\stage\Nvx_clients_par_BG_2006_S14.xls")



If FeuilleExiste(NomFeuille, XlBook) Then

  Set XlSheet = XlBook.Worksheets("NomFeuille")

   ' efface les données

   XlSheet.Cells.Clear

Else

   ' Ajouter nouvelle feuille en dernière position

   Set XlSheet = XlBook.Worksheets.Add(, XlBook.Worksheets(XlBook.Worksheets.Count - 2))

   XlSheet.Name = NomFeuille



End If



Set Db = CurrentDb



 ' Copie dans feuille (nouvelle ou effacée)



If DCount("*", "T31_Cumul_Nvx_clients_par_BG") > 0 Then

    Set Db = CurrentDb

     ' Copie dans feuille (nouvelle ou effacée)

    Set Rs = Db.OpenRecordset("T31_Cumul_Nvx_clients_par_BG", , dbOpenForwardOnly)

    Rs.MoveFirst

    LigneCopiees = XlSheet.Range("A1").CopyFromRecordset(Rs)

     ' Ferme les Var

    Rs.Close: Set Rs = Nothing

    Db.Close: Set Db = Nothing

Else

    MsgBox "Pas de données"

End If

 ' Ferme les Var

Set XlSheet = Nothing

 ' Sauve le fichier

XlBook.Save

'XlBook.Close

Set XlBook = Nothing

Set Xlapp = Nothing

Exit Sub

errOuvrirExcel:

'Err 429 : Un serveur OLE Automation ne peut pas créer d'objet

' -> Excel n'est PAS encore ouvert.

If Err = 429 Then

Set Xlapp = CreateObject("Excel.Application")

Resume Next

End If

oups:

MsgBox Err.Number & " - " & Err.Description

 End Sub

 Function FeuilleExiste(NomFeuille As String, Classeur As Excel.Workbook) As Boolean

Dim errNum As Long, strName As String

  errNum = 0: Err.Clear

   On Error Resume Next

   strName = Classeur.Worksheets(NomFeuille).Name

   errNum = Err.Number

   On Error GoTo 0

   If errNum = 0 Then FeuilleExiste = True Else FeuilleExiste = False

End Function